{-# 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)
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