{- 
    Copyright 2013-2018 Mario Blazevic

    License: BSD3 (see BSD3-LICENSE.txt file)
-}

-- | This module defines the monoid transformer data type 'Measured'.
-- 

{-# LANGUAGE Haskell2010 #-}

module Data.Monoid.Instances.Measured (
   Measured, measure, extract
   )
where

import Data.Functor -- ((<$>))
import qualified Data.List as List
import Data.String (IsString(..))
import Data.Semigroup -- (Semigroup(..))
import Data.Monoid (Monoid(..))
import Data.Monoid.Cancellative (LeftReductiveMonoid(..), RightReductiveMonoid(..),
                                 LeftGCDMonoid(..), RightGCDMonoid(..))
import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
import Data.Monoid.Factorial (FactorialMonoid(..), StableFactorialMonoid)
import Data.Monoid.Textual (TextualMonoid(..))
import qualified Data.Monoid.Factorial as Factorial
import qualified Data.Monoid.Textual as Textual

import Prelude hiding (all, any, break, filter, foldl, foldl1, foldr, foldr1, map, concatMap,
                       length, null, reverse, scanl, scanr, scanl1, scanr1, span, splitAt)

-- | @'Measured' a@ is a wrapper around the 'FactorialMonoid' @a@ that memoizes the monoid's 'length' so it becomes a
-- constant-time operation. The parameter is restricted to the 'StableFactorialMonoid' class, which guarantees that
-- @'length' (a <> b) == 'length' a + 'length' b@.

data Measured a = Measured{Measured a -> Int
_measuredLength :: Int, Measured a -> a
extract :: a} deriving (Measured a -> Measured a -> Bool
(Measured a -> Measured a -> Bool)
-> (Measured a -> Measured a -> Bool) -> Eq (Measured a)
forall a. Eq a => Measured a -> Measured a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Measured a -> Measured a -> Bool
$c/= :: forall a. Eq a => Measured a -> Measured a -> Bool
== :: Measured a -> Measured a -> Bool
$c== :: forall a. Eq a => Measured a -> Measured a -> Bool
Eq, Int -> Measured a -> ShowS
[Measured a] -> ShowS
Measured a -> String
(Int -> Measured a -> ShowS)
-> (Measured a -> String)
-> ([Measured a] -> ShowS)
-> Show (Measured a)
forall a. Show a => Int -> Measured a -> ShowS
forall a. Show a => [Measured a] -> ShowS
forall a. Show a => Measured a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Measured a] -> ShowS
$cshowList :: forall a. Show a => [Measured a] -> ShowS
show :: Measured a -> String
$cshow :: forall a. Show a => Measured a -> String
showsPrec :: Int -> Measured a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Measured a -> ShowS
Show)

-- | Create a new 'Measured' value.
measure :: FactorialMonoid a => a -> Measured a
measure :: a -> Measured a
measure a
x = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (a -> Int
forall m. FactorialMonoid m => m -> Int
length a
x) a
x

instance Ord a => Ord (Measured a) where
   compare :: Measured a -> Measured a -> Ordering
compare (Measured Int
_ a
x) (Measured Int
_ a
y) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y

instance StableFactorialMonoid a => Semigroup (Measured a) where
   Measured Int
m a
a <> :: Measured a -> Measured a -> Measured a
<> Measured Int
n a
b = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
b)

instance StableFactorialMonoid a => Monoid (Measured a) where
   mempty :: Measured a
mempty = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
0 a
forall a. Monoid a => a
mempty
   mappend :: Measured a -> Measured a -> Measured a
mappend (Measured Int
m a
a) (Measured Int
n a
b) = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
a a
b)

instance StableFactorialMonoid a => MonoidNull (Measured a) where
   null :: Measured a -> Bool
null (Measured Int
n a
_) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

instance StableFactorialMonoid a => PositiveMonoid (Measured a)

instance (LeftReductiveMonoid a, StableFactorialMonoid a) => LeftReductiveMonoid (Measured a) where
   stripPrefix :: Measured a -> Measured a -> Maybe (Measured a)
stripPrefix (Measured Int
m a
x) (Measured Int
n a
y) = (a -> Measured a) -> Maybe a -> Maybe (Measured a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)) (a -> a -> Maybe a
forall m. LeftReductiveMonoid m => m -> m -> Maybe m
stripPrefix a
x a
y)

instance (RightReductiveMonoid a, StableFactorialMonoid a) => RightReductiveMonoid (Measured a) where
   stripSuffix :: Measured a -> Measured a -> Maybe (Measured a)
stripSuffix (Measured Int
m a
x) (Measured Int
n a
y) = (a -> Measured a) -> Maybe a -> Maybe (Measured a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m)) (a -> a -> Maybe a
forall m. RightReductiveMonoid m => m -> m -> Maybe m
stripSuffix a
x a
y)

instance (LeftGCDMonoid a, StableFactorialMonoid a) => LeftGCDMonoid (Measured a) where
   commonPrefix :: Measured a -> Measured a -> Measured a
commonPrefix (Measured Int
_ a
x) (Measured Int
_ a
y) = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure (a -> a -> a
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
x a
y)

instance (RightGCDMonoid a, StableFactorialMonoid a) => RightGCDMonoid (Measured a) where
   commonSuffix :: Measured a -> Measured a -> Measured a
commonSuffix (Measured Int
_ a
x) (Measured Int
_ a
y) = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure (a -> a -> a
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
x a
y)

instance StableFactorialMonoid a => FactorialMonoid (Measured a) where
   factors :: Measured a -> [Measured a]
factors (Measured Int
_ a
x) = (a -> Measured a) -> [a] -> [Measured a]
forall a b. (a -> b) -> [a] -> [b]
List.map (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) (a -> [a]
forall m. FactorialMonoid m => m -> [m]
factors a
x)
   primePrefix :: Measured a -> Measured a
primePrefix m :: Measured a
m@(Measured Int
_ a
x) = if a -> Bool
forall m. MonoidNull m => m -> Bool
null a
x then Measured a
m else Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1 (a -> a
forall m. FactorialMonoid m => m -> m
primePrefix a
x)
   primeSuffix :: Measured a -> Measured a
primeSuffix m :: Measured a
m@(Measured Int
_ a
x) = if a -> Bool
forall m. MonoidNull m => m -> Bool
null a
x then Measured a
m else Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1 (a -> a
forall m. FactorialMonoid m => m -> m
primeSuffix a
x)
   splitPrimePrefix :: Measured a -> Maybe (Measured a, Measured a)
splitPrimePrefix (Measured Int
n a
x) = case a -> Maybe (a, a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix a
x
                                     of Maybe (a, a)
Nothing -> Maybe (Measured a, Measured a)
forall a. Maybe a
Nothing
                                        Just (a
p, a
s) -> (Measured a, Measured a) -> Maybe (Measured a, Measured a)
forall a. a -> Maybe a
Just (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1 a
p, Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
s)
   splitPrimeSuffix :: Measured a -> Maybe (Measured a, Measured a)
splitPrimeSuffix (Measured Int
n a
x) = case a -> Maybe (a, a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimeSuffix a
x
                                     of Maybe (a, a)
Nothing -> Maybe (Measured a, Measured a)
forall a. Maybe a
Nothing
                                        Just (a
p, a
s) -> (Measured a, Measured a) -> Maybe (Measured a, Measured a)
forall a. a -> Maybe a
Just (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
p, Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1 a
s)
   foldl :: (a -> Measured a -> a) -> a -> Measured a -> a
foldl a -> Measured a -> a
f a
a0 (Measured Int
_ a
x) = (a -> a -> a) -> a -> a -> a
forall m a. FactorialMonoid m => (a -> m -> a) -> a -> m -> a
Factorial.foldl a -> a -> a
g a
a0 a
x
      where g :: a -> a -> a
g a
a = a -> Measured a -> a
f a
a (Measured a -> a) -> (a -> Measured a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1
   foldl' :: (a -> Measured a -> a) -> a -> Measured a -> a
foldl' a -> Measured a -> a
f a
a0 (Measured Int
_ a
x) = (a -> a -> a) -> a -> a -> a
forall m a. FactorialMonoid m => (a -> m -> a) -> a -> m -> a
Factorial.foldl' a -> a -> a
g a
a0 a
x
      where g :: a -> a -> a
g a
a = a -> Measured a -> a
f a
a (Measured a -> a) -> (a -> Measured a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1
   foldr :: (Measured a -> a -> a) -> a -> Measured a -> a
foldr Measured a -> a -> a
f a
a0 (Measured Int
_ a
x) = (a -> a -> a) -> a -> a -> a
forall m a. FactorialMonoid m => (m -> a -> a) -> a -> m -> a
Factorial.foldr a -> a -> a
g a
a0 a
x
      where g :: a -> a -> a
g = Measured a -> a -> a
f (Measured a -> a -> a) -> (a -> Measured a) -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1
   length :: Measured a -> Int
length (Measured Int
n a
_) = Int
n
   foldMap :: (Measured a -> n) -> Measured a -> n
foldMap Measured a -> n
f (Measured Int
_ a
x) = (a -> n) -> a -> n
forall m n. (FactorialMonoid m, Monoid n) => (m -> n) -> m -> n
Factorial.foldMap (Measured a -> n
f (Measured a -> n) -> (a -> Measured a) -> a -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) a
x
   span :: (Measured a -> Bool) -> Measured a -> (Measured a, Measured a)
span Measured a -> Bool
p (Measured Int
n a
x) = (Measured a
xp', Measured a
xs')
      where (a
xp, a
xs) = (a -> Bool) -> a -> (a, a)
forall m. FactorialMonoid m => (m -> Bool) -> m -> (m, m)
Factorial.span (Measured a -> Bool
p (Measured a -> Bool) -> (a -> Measured a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) a
x
            xp' :: Measured a
xp' = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure a
xp
            xs' :: Measured a
xs' = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Measured a -> Int
forall m. FactorialMonoid m => m -> Int
length Measured a
xp') a
xs
   split :: (Measured a -> Bool) -> Measured a -> [Measured a]
split Measured a -> Bool
p (Measured Int
_ a
x) = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure (a -> Measured a) -> [a] -> [Measured a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Bool) -> a -> [a]
forall m. FactorialMonoid m => (m -> Bool) -> m -> [m]
Factorial.split (Measured a -> Bool
p (Measured a -> Bool) -> (a -> Measured a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) a
x
   splitAt :: Int -> Measured a -> (Measured a, Measured a)
splitAt Int
m (Measured Int
n a
x) | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = (Measured a
forall a. Monoid a => a
mempty, Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
n a
x)
                            | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
n a
x, Measured a
forall a. Monoid a => a
mempty)
                            | Bool
otherwise = (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
m a
xp, Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) a
xs)
      where (a
xp, a
xs) = Int -> a -> (a, a)
forall m. FactorialMonoid m => Int -> m -> (m, m)
splitAt Int
m a
x
   reverse :: Measured a -> Measured a
reverse (Measured Int
n a
x) = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
n (a -> a
forall m. FactorialMonoid m => m -> m
reverse a
x)

instance StableFactorialMonoid a => StableFactorialMonoid (Measured a)

instance (FactorialMonoid a, IsString a) => IsString (Measured a) where
   fromString :: String -> Measured a
fromString = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure (a -> Measured a) -> (String -> a) -> String -> Measured a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

instance (Eq a, TextualMonoid a, StableFactorialMonoid a) => TextualMonoid (Measured a) where
   fromText :: Text -> Measured a
fromText = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure (a -> Measured a) -> (Text -> a) -> Text -> Measured a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
forall t. TextualMonoid t => Text -> t
fromText
   singleton :: Char -> Measured a
singleton = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1 (a -> Measured a) -> (Char -> a) -> Char -> Measured a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> a
forall t. TextualMonoid t => Char -> t
singleton
   splitCharacterPrefix :: Measured a -> Maybe (Char, Measured a)
splitCharacterPrefix (Measured Int
n a
x) = (Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (a -> Measured a) -> (Char, a) -> (Char, Measured a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Char, a) -> (Char, Measured a))
-> Maybe (Char, a) -> Maybe (Char, Measured a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe (Char, a)
forall t. TextualMonoid t => t -> Maybe (Char, t)
splitCharacterPrefix a
x
   characterPrefix :: Measured a -> Maybe Char
characterPrefix (Measured Int
_ a
x) = a -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
characterPrefix a
x
   map :: (Char -> Char) -> Measured a -> Measured a
map Char -> Char
f (Measured Int
n a
x) = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
n ((Char -> Char) -> a -> a
forall t. TextualMonoid t => (Char -> Char) -> t -> t
map Char -> Char
f a
x)
   any :: (Char -> Bool) -> Measured a -> Bool
any Char -> Bool
p (Measured Int
_ a
x) = (Char -> Bool) -> a -> Bool
forall t. TextualMonoid t => (Char -> Bool) -> t -> Bool
any Char -> Bool
p a
x
   all :: (Char -> Bool) -> Measured a -> Bool
all Char -> Bool
p (Measured Int
_ a
x) = (Char -> Bool) -> a -> Bool
forall t. TextualMonoid t => (Char -> Bool) -> t -> Bool
all Char -> Bool
p a
x

   foldl :: (a -> Measured a -> a) -> (a -> Char -> a) -> a -> Measured a -> a
foldl a -> Measured a -> a
ft a -> Char -> a
fc a
a0 (Measured Int
_ a
x) = (a -> a -> a) -> (a -> Char -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
Textual.foldl (\a
a-> a -> Measured a -> a
ft a
a (Measured a -> a) -> (a -> Measured a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) a -> Char -> a
fc a
a0 a
x
   foldl' :: (a -> Measured a -> a) -> (a -> Char -> a) -> a -> Measured a -> a
foldl' a -> Measured a -> a
ft a -> Char -> a
fc a
a0 (Measured Int
_ a
x) = (a -> a -> a) -> (a -> Char -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(a -> t -> a) -> (a -> Char -> a) -> a -> t -> a
Textual.foldl' (\a
a-> a -> Measured a -> a
ft a
a (Measured a -> a) -> (a -> Measured a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) a -> Char -> a
fc a
a0 a
x
   foldr :: (Measured a -> a -> a) -> (Char -> a -> a) -> a -> Measured a -> a
foldr Measured a -> a -> a
ft Char -> a -> a
fc a
a0 (Measured Int
_ a
x) = (a -> a -> a) -> (Char -> a -> a) -> a -> a -> a
forall t a.
TextualMonoid t =>
(t -> a -> a) -> (Char -> a -> a) -> a -> t -> a
Textual.foldr (Measured a -> a -> a
ft (Measured a -> a -> a) -> (a -> Measured a) -> a -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) Char -> a -> a
fc a
a0 a
x
   toString :: (Measured a -> String) -> Measured a -> String
toString Measured a -> String
ft (Measured Int
_ a
x) = (a -> String) -> a -> String
forall t. TextualMonoid t => (t -> String) -> t -> String
toString (Measured a -> String
ft (Measured a -> String) -> (a -> Measured a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) a
x

   span :: (Measured a -> Bool)
-> (Char -> Bool) -> Measured a -> (Measured a, Measured a)
span Measured a -> Bool
pt Char -> Bool
pc (Measured Int
n a
x) = (Measured a
xp', Measured a
xs')
      where (a
xp, a
xs) = (a -> Bool) -> (Char -> Bool) -> a -> (a, a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
Textual.span (Measured a -> Bool
pt (Measured a -> Bool) -> (a -> Measured a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured Int
1) Char -> Bool
pc a
x
            xp' :: Measured a
xp' = a -> Measured a
forall a. FactorialMonoid a => a -> Measured a
measure a
xp
            xs' :: Measured a
xs' = Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Measured a -> Int
forall m. FactorialMonoid m => m -> Int
length Measured a
xp') a
xs
   break :: (Measured a -> Bool)
-> (Char -> Bool) -> Measured a -> (Measured a, Measured a)
break Measured a -> Bool
pt Char -> Bool
pc = (Measured a -> Bool)
-> (Char -> Bool) -> Measured a -> (Measured a, Measured a)
forall t.
TextualMonoid t =>
(t -> Bool) -> (Char -> Bool) -> t -> (t, t)
Textual.span (Bool -> Bool
not (Bool -> Bool) -> (Measured a -> Bool) -> Measured a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measured a -> Bool
pt) (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
pc)

   find :: (Char -> Bool) -> Measured a -> Maybe Char
find Char -> Bool
p (Measured Int
_ a
x) = (Char -> Bool) -> a -> Maybe Char
forall t. TextualMonoid t => (Char -> Bool) -> t -> Maybe Char
find Char -> Bool
p a
x