module Data.Monoid.Factorial (
FactorialMonoid(..),
mbreak, mlength, mmap, mreverse, mtakeWhile, mdropWhile
)
where
import Data.Monoid (Monoid (..))
import qualified Data.List as List
import qualified Data.ByteString as ByteString
import qualified Data.Text as Text
import Data.ByteString (ByteString)
import Data.Text (Text)
class Monoid m => FactorialMonoid m where
factors :: m -> [m]
primePrefix :: m -> m
primeSuffix :: m -> m
splitPrimePrefix :: m -> Maybe (m, m)
splitPrimeSuffix :: m -> Maybe (m, m)
mfoldl :: (a -> m -> a) -> a -> m -> a
mfoldr :: (m -> a -> a) -> a -> m -> a
mspan :: (m -> Bool) -> m -> (m, m)
factors = List.unfoldr splitPrimePrefix
primePrefix = maybe mempty fst . splitPrimePrefix
primeSuffix = maybe mempty snd . splitPrimeSuffix
splitPrimePrefix x = case factors x
of [] -> Nothing
prefix : rest -> Just (prefix, mconcat rest)
splitPrimeSuffix x = case factors x
of [] -> Nothing
fs -> Just (mconcat (List.init fs), List.last fs)
mfoldl f f0 = List.foldl f f0 . factors
mfoldr f f0 = List.foldr f f0 . factors
mspan p = mfoldr f (mempty, mempty)
where f s (prefix, suffix) = if p s
then (mappend s prefix, suffix)
else (mempty, mappend s (mappend prefix suffix))
instance FactorialMonoid [x] where
factors xs = List.map (:[]) xs
primePrefix [] = []
primePrefix (x:xs) = [x]
primeSuffix [] = []
primeSuffix xs = [List.last xs]
splitPrimePrefix [] = Nothing
splitPrimePrefix (x:xs) = Just ([x], xs)
splitPrimeSuffix [] = Nothing
splitPrimeSuffix xs = Just (split id xs)
where split f last@[x] = (f [], last)
split f (x:xs) = split (f . (x:)) xs
mfoldl _ acc [] = acc
mfoldl f acc (x:xs) = mfoldl f (f acc [x]) xs
mfoldr _ f0 [] = f0
mfoldr f f0 (x:xs) = f [x] (mfoldr f f0 xs)
mspan f = List.span (f . (:[]))
instance FactorialMonoid ByteString where
factors x = factorize (ByteString.length x) x
where factorize 0 xs = []
factorize n xs = x : factorize (pred n) xs'
where (x, xs') = ByteString.splitAt 1 xs
primePrefix = ByteString.take 1
primeSuffix x = ByteString.drop (ByteString.length x 1) x
splitPrimePrefix x = if ByteString.null x then Nothing else Just (ByteString.splitAt 1 x)
splitPrimeSuffix x = if ByteString.null x then Nothing else Just (ByteString.splitAt (ByteString.length x 1) x)
mfoldl f = ByteString.foldl f'
where f' a byte = f a (ByteString.singleton byte)
mfoldr f = ByteString.foldr f'
where f' byte a = f (ByteString.singleton byte) a
mspan f x = ByteString.splitAt (findIndex 0 x) x
where findIndex i x | ByteString.null x = i
findIndex i x = if f (ByteString.take 1 x) then findIndex (succ i) (ByteString.drop 1 x) else i
instance FactorialMonoid Text where
factors = Text.chunksOf 1
primePrefix = Text.take 1
primeSuffix x = if Text.null x then Text.empty else Text.singleton (Text.last x)
splitPrimePrefix x = if Text.null x then Nothing else Just (Text.splitAt 1 x)
splitPrimeSuffix x = if Text.null x then Nothing else Just (Text.splitAt (Text.length x 1) x)
mfoldl f = Text.foldl f'
where f' a char = f a (Text.singleton char)
mfoldr f = Text.foldr f'
where f' char a = f (Text.singleton char) a
mspan f = Text.span (f . Text.singleton)
mbreak :: FactorialMonoid m => (m -> Bool) -> m -> (m, m)
mbreak = mspan . (not .)
mlength :: FactorialMonoid m => m -> Int
mlength = List.length . factors
mmap :: FactorialMonoid m => (m -> m) -> m -> m
mmap f = mconcat . List.map f . factors
mreverse :: FactorialMonoid m => m -> m
mreverse = mconcat . List.reverse . factors
mtakeWhile :: FactorialMonoid m => (m -> Bool) -> m -> m
mtakeWhile p = fst . mspan p
mdropWhile :: FactorialMonoid m => (m -> Bool) -> m -> m
mdropWhile p = snd . mspan p