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