{-# LANGUAGE OverloadedStrings #-}
module Foundation.Conduit.Textual
    ( lines
    , words
    , fromBytes
    , toBytes
    ) where

import           Basement.Imports hiding (throw)
import           Foundation.Collection
import qualified Basement.String as S
import           Foundation.Conduit.Internal
import           Foundation.Monad
import           Data.Char (isSpace)

-- | Split conduit of string to its lines
--
-- This is very similar to Prelude lines except
-- it work directly on Conduit
--
-- Note that if the newline character is not ever appearing in the stream,
-- this function will keep accumulating data until OOM
--
-- TODO: make a size-limited function
lines :: Monad m => Conduit String String m ()
lines :: forall (m :: * -> *). Monad m => Conduit String String m ()
lines = forall i o (m :: * -> *). Conduit i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Conduit String String m ()
finish []) (Bool -> [String] -> String -> Conduit String String m ()
go Bool
False [])
  where
    mconcatRev :: [String] -> String
mconcatRev = forall a. Monoid a => [a] -> a
mconcat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall c. Sequential c => c -> c
reverse

    finish :: [String] -> Conduit String String m ()
finish [String]
l = if forall c. Collection c => c -> Bool
null [String]
l then forall (m :: * -> *) a. Monad m => a -> m a
return () else forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev [String]
l)

    go :: Bool -> [String] -> String -> Conduit String String m ()
go Bool
prevCR [String]
prevs String
nextBuf = do
        case String -> Either Bool (String, String)
S.breakLine String
nextBuf of
            Right (String
line, String
next)
                | String -> Bool
S.null String
line Bool -> Bool -> Bool
&& Bool
prevCR -> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev (String
line forall a. a -> [a] -> [a]
: [String] -> [String]
stripCRFromHead [String]
prevs)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [String] -> String -> Conduit String String m ()
go Bool
False forall a. Monoid a => a
mempty String
next
                | Bool
otherwise             -> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev (String
line forall a. a -> [a] -> [a]
: [String]
prevs)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [String] -> String -> Conduit String String m ()
go Bool
False forall a. Monoid a => a
mempty String
next
            Left Bool
lastCR ->
                let nextCurrent :: [String]
nextCurrent = String
nextBuf forall a. a -> [a] -> [a]
: [String]
prevs
                 in forall i o (m :: * -> *). Conduit i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Conduit String String m ()
finish [String]
nextCurrent) (Bool -> [String] -> String -> Conduit String String m ()
go Bool
lastCR [String]
nextCurrent)
    stripCRFromHead :: [String] -> [String]
stripCRFromHead []     = []
    stripCRFromHead (String
x:[String]
xs) = CountOf Char -> String -> String
S.revDrop CountOf Char
1 String
xforall a. a -> [a] -> [a]
:[String]
xs

words :: Monad m => Conduit String String m ()
words :: forall (m :: * -> *). Monad m => Conduit String String m ()
words = forall i o (m :: * -> *). Conduit i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Conduit String String m ()
finish []) ([String] -> String -> Conduit String String m ()
go [])
  where
    mconcatRev :: [String] -> String
mconcatRev = forall a. Monoid a => [a] -> a
mconcat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall c. Sequential c => c -> c
reverse

    finish :: [String] -> Conduit String String m ()
finish [String]
l = if forall c. Collection c => c -> Bool
null [String]
l then forall (m :: * -> *) a. Monad m => a -> m a
return () else forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev [String]
l)

    go :: [String] -> String -> Conduit String String m ()
go [String]
prevs String
nextBuf =
        case (Char -> Bool) -> String -> String
S.dropWhile Char -> Bool
isSpace String
next' of
            String
rest' 
                | forall c. Collection c => c -> Bool
null String
rest' ->
                    let nextCurrent :: [String]
nextCurrent = String
nextBuf forall a. a -> [a] -> [a]
: [String]
prevs
                     in forall i o (m :: * -> *). Conduit i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Conduit String String m ()
finish [String]
nextCurrent) ([String] -> String -> Conduit String String m ()
go [String]
nextCurrent)
                | Bool
otherwise  -> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev (String
line forall a. a -> [a] -> [a]
: [String]
prevs)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> String -> Conduit String String m ()
go forall a. Monoid a => a
mempty String
rest'
      where (String
line, String
next') = (Char -> Bool) -> String -> (String, String)
S.break Char -> Bool
isSpace String
nextBuf

fromBytes :: MonadThrow m => S.Encoding -> Conduit (UArray Word8) String m ()
fromBytes :: forall (m :: * -> *).
MonadThrow m =>
Encoding -> Conduit (UArray Word8) String m ()
fromBytes Encoding
encoding = UArray Word8 -> Conduit (UArray Word8) String m ()
loop forall a. Monoid a => a
mempty
  where
    loop :: UArray Word8 -> Conduit (UArray Word8) String m ()
loop UArray Word8
r = forall i o (m :: * -> *). Conduit i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UArray Word8 -> Conduit (UArray Word8) String m ()
finish UArray Word8
r) (UArray Word8 -> UArray Word8 -> Conduit (UArray Word8) String m ()
go UArray Word8
r)
    finish :: UArray Word8 -> Conduit (UArray Word8) String m ()
finish UArray Word8
buf | forall c. Collection c => c -> Bool
null UArray Word8
buf  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
               | Bool
otherwise = case Encoding
-> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)
S.fromBytes Encoding
encoding UArray Word8
buf of
                                    (String
s, Maybe ValidationFailure
Nothing, UArray Word8
_)  -> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield String
s
                                    (String
_, Just ValidationFailure
err, UArray Word8
_) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw ValidationFailure
err
    go :: UArray Word8 -> UArray Word8 -> Conduit (UArray Word8) String m ()
go UArray Word8
current UArray Word8
nextBuf =
        case Encoding
-> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)
S.fromBytes Encoding
encoding (UArray Word8
current forall a. Monoid a => a -> a -> a
`mappend` UArray Word8
nextBuf) of
            (String
s, Maybe ValidationFailure
Nothing           , UArray Word8
r) -> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UArray Word8 -> Conduit (UArray Word8) String m ()
loop UArray Word8
r
            (String
s, Just ValidationFailure
S.MissingByte, UArray Word8
r) -> forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield String
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UArray Word8 -> Conduit (UArray Word8) String m ()
loop UArray Word8
r
            (String
_, Just ValidationFailure
err          , UArray Word8
_) -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw ValidationFailure
err

toBytes :: Monad m => S.Encoding -> Conduit String (UArray Word8) m ()
toBytes :: forall (m :: * -> *).
Monad m =>
Encoding -> Conduit String (UArray Word8) m ()
toBytes Encoding
encoding = forall input output (monad :: * -> *) b.
(input -> Conduit input output monad b)
-> Conduit input output monad ()
awaitForever forall a b. (a -> b) -> a -> b
$ \String
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> String -> UArray Word8
S.toBytes Encoding
encoding String
a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield