module Control.Foldl.Text (
fold
, foldM
, head
, last
, null
, length
, any
, all
, maximum
, minimum
, elem
, notElem
, find
, index
, elemIndex
, findIndex
, count
, lazy
, module Control.Foldl
, module Data.Text
) where
import Control.Foldl (Fold, FoldM)
import Control.Foldl.Internal (Maybe'(..), strict, Either'(..), hush)
import Data.Text (Text)
import Prelude hiding (
head, last, null, length, any, all, maximum, minimum, elem, notElem )
import qualified Control.Foldl
import qualified Control.Foldl.Internal
import qualified Data.Text
import qualified Data.Text.Lazy
fold :: Fold Text a -> Data.Text.Lazy.Text -> a
fold (Control.Foldl.Fold step begin done) as =
done (Data.Text.Lazy.foldlChunks step begin as)
{-# INLINABLE fold #-}
foldM :: Monad m => FoldM m Text a -> Data.Text.Lazy.Text -> m a
foldM (Control.Foldl.FoldM step begin done) as = do
x <- Data.Text.Lazy.foldlChunks step' begin as
done x
where
step' mx bs = do
x <- mx
x `seq` step x bs
{-# INLINABLE foldM #-}
head :: Fold Text (Maybe Char)
head = Control.Foldl.Fold step Nothing' Control.Foldl.Internal.lazy
where
step mc txt =
if Data.Text.null txt
then mc
else case mc of
Just' _ -> mc
Nothing' -> Just' (Data.Text.head txt)
{-# INLINABLE head #-}
last :: Fold Text (Maybe Char)
last = Control.Foldl.Fold step Nothing' Control.Foldl.Internal.lazy
where
step mc txt =
if Data.Text.null txt
then mc
else Just' (Data.Text.last txt)
{-# INLINABLE last #-}
null :: Fold Text Bool
null = Control.Foldl.Fold step True id
where
step isNull txt = isNull && Data.Text.null txt
{-# INLINABLE null #-}
length :: Num n => Fold Text n
length =
Control.Foldl.Fold (\n txt -> n + fromIntegral (Data.Text.length txt)) 0 id
{-# INLINABLE length #-}
all :: (Char -> Bool) -> Fold Text Bool
all predicate =
Control.Foldl.Fold (\b txt -> b && Data.Text.all predicate txt) True id
{-# INLINABLE all #-}
any :: (Char -> Bool) -> Fold Text Bool
any predicate =
Control.Foldl.Fold (\b txt -> b || Data.Text.any predicate txt) False id
{-# INLINABLE any #-}
maximum :: Fold Text (Maybe Char)
maximum = Control.Foldl.Fold step Nothing' Control.Foldl.Internal.lazy
where
step mc txt =
if Data.Text.null txt
then mc
else Just' (case mc of
Nothing' -> Data.Text.maximum txt
Just' c -> max c (Data.Text.maximum txt) )
{-# INLINABLE maximum #-}
minimum :: Fold Text (Maybe Char)
minimum = Control.Foldl.Fold step Nothing' Control.Foldl.Internal.lazy
where
step mc txt =
if Data.Text.null txt
then mc
else Just' (case mc of
Nothing' -> Data.Text.minimum txt
Just' c -> min c (Data.Text.minimum txt) )
{-# INLINABLE minimum #-}
elem :: Char -> Fold Text Bool
elem c = any (c ==)
{-# INLINABLE elem #-}
notElem :: Char -> Fold Text Bool
notElem c = all (c /=)
{-# INLINABLE notElem #-}
find :: (Char -> Bool) -> Fold Text (Maybe Char)
find predicate = Control.Foldl.Fold step Nothing' Control.Foldl.Internal.lazy
where
step mc txt = case mc of
Nothing' -> strict (Data.Text.find predicate txt)
Just' _ -> mc
{-# INLINABLE find #-}
index :: Integral n => n -> Fold Text (Maybe Char)
index i = Control.Foldl.Fold step (Left' (fromIntegral i)) hush
where
step x txt = case x of
Left' remainder ->
let len = Data.Text.length txt
in if remainder < len
then Right' (Data.Text.index txt remainder)
else Left' (remainder - len)
_ -> x
{-# INLINABLE index #-}
elemIndex :: Num n => Char -> Fold Text (Maybe n)
elemIndex c = findIndex (c ==)
{-# INLINABLE elemIndex #-}
findIndex :: Num n => (Char -> Bool) -> Fold Text (Maybe n)
findIndex predicate = Control.Foldl.Fold step (Left' 0) hush
where
step x txt = case x of
Left' m -> case Data.Text.findIndex predicate txt of
Nothing -> Left' (m + fromIntegral (Data.Text.length txt))
Just n -> Right' (m + fromIntegral n)
_ -> x
{-# INLINABLE findIndex #-}
count :: Num n => Char -> Fold Text n
count c = Control.Foldl.Fold step 0 id
where
step n txt = n + fromIntegral (Data.Text.count (Data.Text.singleton c) txt)
{-# INLINABLE count #-}
lazy :: Fold Text Data.Text.Lazy.Text
lazy = fmap Data.Text.Lazy.fromChunks Control.Foldl.list
{-# INLINABLE lazy #-}