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