{-# 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 :: Conduit String String m ()
lines = Conduit String String m (Maybe String)
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit String String m (Maybe String)
-> (Maybe String -> Conduit String String m ())
-> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Conduit String String m ()
-> (String -> Conduit String String m ())
-> Maybe String
-> Conduit String String m ()
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 = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [String] -> [String]
forall c. Sequential c => c -> c
reverse

    finish :: [String] -> Conduit String String m ()
finish [String]
l = if [String] -> Bool
forall c. Collection c => c -> Bool
null [String]
l then () -> Conduit String String m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Conduit String String m ()
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 -> String -> Conduit String String m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev (String
line String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
stripCRFromHead [String]
prevs)) Conduit String String m ()
-> Conduit String String m () -> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [String] -> String -> Conduit String String m ()
go Bool
False [String]
forall a. Monoid a => a
mempty String
next
                | Bool
otherwise             -> String -> Conduit String String m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev (String
line String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevs)) Conduit String String m ()
-> Conduit String String m () -> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> [String] -> String -> Conduit String String m ()
go Bool
False [String]
forall a. Monoid a => a
mempty String
next
            Left Bool
lastCR ->
                let nextCurrent :: [String]
nextCurrent = String
nextBuf String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevs
                 in Conduit String String m (Maybe String)
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit String String m (Maybe String)
-> (Maybe String -> Conduit String String m ())
-> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Conduit String String m ()
-> (String -> Conduit String String m ())
-> Maybe String
-> Conduit String String m ()
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
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
xs

words :: Monad m => Conduit String String m ()
words :: Conduit String String m ()
words = Conduit String String m (Maybe String)
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit String String m (Maybe String)
-> (Maybe String -> Conduit String String m ())
-> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Conduit String String m ()
-> (String -> Conduit String String m ())
-> Maybe String
-> Conduit String String m ()
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 = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [String] -> [String]
forall c. Sequential c => c -> c
reverse

    finish :: [String] -> Conduit String String m ()
finish [String]
l = if [String] -> Bool
forall c. Collection c => c -> Bool
null [String]
l then () -> Conduit String String m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else String -> Conduit String String m ()
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' 
                | String -> Bool
forall c. Collection c => c -> Bool
null String
rest' ->
                    let nextCurrent :: [String]
nextCurrent = String
nextBuf String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevs
                     in Conduit String String m (Maybe String)
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit String String m (Maybe String)
-> (Maybe String -> Conduit String String m ())
-> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Conduit String String m ()
-> (String -> Conduit String String m ())
-> Maybe String
-> Conduit String String m ()
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  -> String -> Conduit String String m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield ([String] -> String
mconcatRev (String
line String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevs)) Conduit String String m ()
-> Conduit String String m () -> Conduit String String m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> String -> Conduit String String m ()
go [String]
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 :: Encoding -> Conduit (UArray Word8) String m ()
fromBytes Encoding
encoding = UArray Word8 -> Conduit (UArray Word8) String m ()
loop UArray Word8
forall a. Monoid a => a
mempty
  where
    loop :: UArray Word8 -> Conduit (UArray Word8) String m ()
loop UArray Word8
r = Conduit (UArray Word8) String m (Maybe (UArray Word8))
forall i o (m :: * -> *). Conduit i o m (Maybe i)
await Conduit (UArray Word8) String m (Maybe (UArray Word8))
-> (Maybe (UArray Word8) -> Conduit (UArray Word8) String m ())
-> Conduit (UArray Word8) String m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Conduit (UArray Word8) String m ()
-> (UArray Word8 -> Conduit (UArray Word8) String m ())
-> Maybe (UArray Word8)
-> Conduit (UArray Word8) String m ()
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 | UArray Word8 -> Bool
forall c. Collection c => c -> Bool
null UArray Word8
buf  = () -> Conduit (UArray Word8) String m ()
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
_)  -> String -> Conduit (UArray Word8) String m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield String
s
                                    (String
_, Just ValidationFailure
err, UArray Word8
_) -> ValidationFailure -> Conduit (UArray Word8) String m ()
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 UArray Word8 -> UArray Word8 -> UArray Word8
forall a. Monoid a => a -> a -> a
`mappend` UArray Word8
nextBuf) of
            (String
s, Maybe ValidationFailure
Nothing           , UArray Word8
r) -> String -> Conduit (UArray Word8) String m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield String
s Conduit (UArray Word8) String m ()
-> Conduit (UArray Word8) String m ()
-> Conduit (UArray Word8) String m ()
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) -> String -> Conduit (UArray Word8) String m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield String
s Conduit (UArray Word8) String m ()
-> Conduit (UArray Word8) String m ()
-> Conduit (UArray Word8) String m ()
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
_) -> ValidationFailure -> Conduit (UArray Word8) String m ()
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 :: Encoding -> Conduit String (UArray Word8) m ()
toBytes Encoding
encoding = (String -> Conduit String (UArray Word8) m ())
-> Conduit String (UArray Word8) m ()
forall input output (monad :: * -> *) b.
(input -> Conduit input output monad b)
-> Conduit input output monad ()
awaitForever ((String -> Conduit String (UArray Word8) m ())
 -> Conduit String (UArray Word8) m ())
-> (String -> Conduit String (UArray Word8) m ())
-> Conduit String (UArray Word8) m ()
forall a b. (a -> b) -> a -> b
$ \String
a -> UArray Word8 -> Conduit String (UArray Word8) m (UArray Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> String -> UArray Word8
S.toBytes Encoding
encoding String
a) Conduit String (UArray Word8) m (UArray Word8)
-> (UArray Word8 -> Conduit String (UArray Word8) m ())
-> Conduit String (UArray Word8) m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UArray Word8 -> Conduit String (UArray Word8) m ()
forall (m :: * -> *) o i. Monad m => o -> Conduit i o m ()
yield