{-
Copyright 2011 Mario Blazevic
This file is part of the Streaming Component Combinators (SCC) project.
The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
version.
SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with SCC. If not, see
<http://www.gnu.org/licenses/>.
-}
-- | This module defines the 'FactorialMonoid' class.
--
module Data.Monoid.Factorial (
-- * Classes
FactorialMonoid(..),
-- * Functions
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 of monoids that can be split into irreducible factors, /i.e./, atoms or primes. The methods of this class
-- satisfy the following laws:
--
-- > mconcat . factors == id
-- > factors mempty == []
-- > all (\f-> factors f == [f]) (factors m)
-- > factors == unfoldr splitPrimePrefix == reverse . unfoldr (fmap swap . splitPrimeSuffix)
-- > primePrefix == maybe mempty fst . splitPrimePrefix
-- > primeSuffix == maybe mempty snd . splitPrimeSuffix
-- > mfoldl f f0 == foldl f f0 . factors
-- > mfoldr f f0 == foldr f f0 . factors
-- > mspan p m == (mconcat l, mconcat r) where (l, r) = span p (factors m)
--
-- A minimal instance definition must implement 'factors' or 'splitPrimePrefix'.
class Monoid m => FactorialMonoid m where
-- | Returns a list of all prime factors; inverse of mconcat.
factors :: m -> [m]
-- | The prime prefix, 'mempty' if none.
primePrefix :: m -> m
-- | The prime suffix, 'mempty' if none.
primeSuffix :: m -> m
-- | Splits the argument into its prime prefix and the remaining suffix. Returns 'Nothing' for 'mempty'.
splitPrimePrefix :: m -> Maybe (m, m)
-- | Splits the argument into its prime suffix and the remaining prefix. Returns 'Nothing' for 'mempty'.
splitPrimeSuffix :: m -> Maybe (m, m)
-- | Like 'foldl' on the list of primes.
mfoldl :: (a -> m -> a) -> a -> m -> a
-- | Like 'foldr' on the list of primes.
mfoldr :: (m -> a -> a) -> a -> m -> a
-- | Like 'span' on the list of primes.
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)
-- | A 'List.break' equivalent.
mbreak :: FactorialMonoid m => (m -> Bool) -> m -> (m, m)
mbreak = mspan . (not .)
-- | A 'List.length' equivalent.
mlength :: FactorialMonoid m => m -> Int
mlength = List.length . factors
-- | A 'List.map' equivalent.
mmap :: FactorialMonoid m => (m -> m) -> m -> m
mmap f = mconcat . List.map f . factors
-- | A 'List.reverse' equivalent.
mreverse :: FactorialMonoid m => m -> m
mreverse = mconcat . List.reverse . factors
-- | A 'List.takeWhile' equivalent.
mtakeWhile :: FactorialMonoid m => (m -> Bool) -> m -> m
mtakeWhile p = fst . mspan p
-- | A 'List.dropWhile' equivalent.
mdropWhile :: FactorialMonoid m => (m -> Bool) -> m -> m
mdropWhile p = snd . mspan p