module Data.Monoid.Textual (
TextualMonoid(..)
)
where
import Prelude hiding (foldl, foldl1, foldr, foldr1, scanl, scanr, scanl1, scanr1, map, concatMap, break, span)
import Data.Maybe (fromJust)
import Data.Either (rights)
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as LazyText
import Data.Text (Text)
import Data.Monoid (Monoid(mappend, mconcat, mempty))
import Data.String (IsString(fromString))
import Data.Monoid.Null (MonoidNull (null))
import Data.Monoid.Cancellative (LeftReductiveMonoid, LeftGCDMonoid)
import Data.Monoid.Factorial (FactorialMonoid)
import qualified Data.Monoid.Factorial as Factorial
class (IsString t, LeftReductiveMonoid t, LeftGCDMonoid t, FactorialMonoid t) => TextualMonoid t where
fromText :: Text -> t
singleton :: Char -> t
splitCharacterPrefix :: t -> Maybe (Char, t)
characterPrefix :: t -> Maybe Char
map :: (Char -> Char) -> t -> t
concatMap :: (Char -> t) -> t -> t
any :: (Char -> Bool) -> t -> Bool
all :: (Char -> Bool) -> t -> Bool
foldl :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
foldl' :: (a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
foldr :: (t -> a -> a) -> (Char -> a -> a) -> a -> t -> a
scanl :: (Char -> Char -> Char) -> Char -> t -> t
scanl1 :: (Char -> Char -> Char) -> t -> t
scanr :: (Char -> Char -> Char) -> Char -> t -> t
scanr1 :: (Char -> Char -> Char) -> t -> t
mapAccumL :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)
mapAccumR :: (a -> Char -> (a, Char)) -> a -> t -> (a, t)
takeWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t
dropWhile :: (t -> Bool) -> (Char -> Bool) -> t -> t
break :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)
span :: (t -> Bool) -> (Char -> Bool) -> t -> (t, t)
split :: (Char -> Bool) -> t -> [t]
find :: (Char -> Bool) -> t -> Maybe Char
fromText = fromString . Text.unpack
singleton = fromString . (:[])
characterPrefix = fmap fst . splitCharacterPrefix
map f = concatMap (singleton . f)
concatMap f = foldr mappend (mappend . f) mempty
all p = foldr (const id) ((&&) . p) True
any p = foldr (const id) ((||) . p) False
foldl ft fc = Factorial.foldl (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))
foldr ft fc = Factorial.foldr (\prime-> maybe (ft prime) fc (characterPrefix prime))
foldl' ft fc = Factorial.foldl' (\a prime-> maybe (ft a prime) (fc a) (characterPrefix prime))
scanl f c = mappend (singleton c) . fst . foldl foldlOther (foldlChars f) (mempty, c)
scanl1 f t = case (Factorial.splitPrimePrefix t, splitCharacterPrefix t)
of (Nothing, _) -> t
(Just (prefix, suffix), Nothing) -> mappend prefix (scanl1 f suffix)
(Just _, Just (c, suffix)) -> scanl f c suffix
scanr f c = fst . foldr foldrOther (foldrChars f) (singleton c, c)
scanr1 f = fst . foldr foldrOther fc (mempty, Nothing)
where fc c (t, Nothing) = (mappend (singleton c) t, Just c)
fc c1 (t, Just c2) = (mappend (singleton c') t, Just c')
where c' = f c1 c2
mapAccumL f a0 = foldl ft fc (a0, mempty)
where ft (a, t1) t2 = (a, mappend t1 t2)
fc (a, t) c = (a', mappend t (singleton c'))
where (a', c') = f a c
mapAccumR f a0 = foldr ft fc (a0, mempty)
where ft t1 (a, t2) = (a, mappend t1 t2)
fc c (a, t) = (a', mappend (singleton c') t)
where (a', c') = f a c
takeWhile pt pc = fst . span pt pc
dropWhile pt pc = snd . span pt pc
span pt pc = Factorial.span (\prime-> maybe (pt prime) pc (characterPrefix prime))
break pt pc = Factorial.break (\prime-> maybe (pt prime) pc (characterPrefix prime))
split f = Factorial.split (maybe False f . characterPrefix)
find f = foldr (const id) (\c r-> if f c then Just c else r) Nothing
foldlChars f (t, c1) c2 = (mappend t (singleton c'), c')
where c' = f c1 c2
foldlOther (t1, c) t2 = (mappend t1 t2, c)
foldrChars f c1 (t, c2) = (mappend (singleton c') t, c')
where c' = f c1 c2
foldrOther t1 (t2, c) = (mappend t1 t2, c)
instance TextualMonoid String where
fromText = Text.unpack
singleton c = [c]
splitCharacterPrefix (c:rest) = Just (c, rest)
splitCharacterPrefix [] = Nothing
characterPrefix (c:_) = Just c
characterPrefix [] = Nothing
map = List.map
concatMap = List.concatMap
any = List.any
all = List.all
foldl = const List.foldl
foldl' = const List.foldl'
foldr = const List.foldr
scanl = List.scanl
scanl1 = List.scanl1
scanr = List.scanr
scanr1 = List.scanr1
mapAccumL = List.mapAccumL
mapAccumR = List.mapAccumR
takeWhile _ = List.takeWhile
dropWhile _ = List.dropWhile
break _ = List.break
span _ = List.span
find = List.find
instance TextualMonoid Text where
fromText = id
singleton = Text.singleton
splitCharacterPrefix = Text.uncons
characterPrefix t = if Text.null t then Nothing else Just (Text.head t)
map = Text.map
concatMap = Text.concatMap
any = Text.any
all = Text.all
foldl = const Text.foldl
foldl' = const Text.foldl'
foldr = const Text.foldr
scanl = Text.scanl
scanl1 = Text.scanl1
scanr = Text.scanr
scanr1 = Text.scanr1
mapAccumL = Text.mapAccumL
mapAccumR = Text.mapAccumR
takeWhile _ = Text.takeWhile
dropWhile _ = Text.dropWhile
break _ = Text.break
span _ = Text.span
split = Text.split
find = Text.find
instance TextualMonoid LazyText.Text where
fromText = LazyText.fromStrict
singleton = LazyText.singleton
splitCharacterPrefix = LazyText.uncons
characterPrefix t = if LazyText.null t then Nothing else Just (LazyText.head t)
map = LazyText.map
concatMap = LazyText.concatMap
any = LazyText.any
all = LazyText.all
foldl = const LazyText.foldl
foldl' = const LazyText.foldl'
foldr = const LazyText.foldr
scanl = LazyText.scanl
scanl1 = LazyText.scanl1
scanr = LazyText.scanr
scanr1 = LazyText.scanr1
mapAccumL = LazyText.mapAccumL
mapAccumR = LazyText.mapAccumR
takeWhile _ = LazyText.takeWhile
dropWhile _ = LazyText.dropWhile
break _ = LazyText.break
span _ = LazyText.span
split = LazyText.split
find = LazyText.find