{- 
    Copyright 2013-2019 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.Semigroup.Cancellative (LeftReductive(..), RightReductive(..))
import Data.Semigroup.Factorial (Factorial(..), StableFactorial)
import Data.Monoid.GCD (LeftGCDMonoid(..), RightGCDMonoid(..))
import Data.Monoid.Null (MonoidNull(null), PositiveMonoid)
import Data.Monoid.Factorial (FactorialMonoid(..))
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 'StableFactorial' 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 :: Factorial 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. Factorial 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 StableFactorial 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 -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)

instance (StableFactorial a, Monoid 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 a -> Measured a -> Measured a
forall a. Semigroup a => a -> a -> a
(<>)

instance (StableFactorial a, Monoid 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 (StableFactorial a, Monoid a) => PositiveMonoid (Measured a)

instance (LeftReductive a, StableFactorial a) => LeftReductive (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. LeftReductive m => m -> m -> Maybe m
stripPrefix a
x a
y)

instance (RightReductive a, StableFactorial a) => RightReductive (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. RightReductive m => m -> m -> Maybe m
stripSuffix a
x a
y)

instance (LeftGCDMonoid a, StableFactorial 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. Factorial a => a -> Measured a
measure (a -> a -> a
forall m. LeftGCDMonoid m => m -> m -> m
commonPrefix a
x a
y)

instance (RightGCDMonoid a, StableFactorial 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. Factorial a => a -> Measured a
measure (a -> a -> a
forall m. RightGCDMonoid m => m -> m -> m
commonSuffix a
x a
y)

instance (StableFactorial a, MonoidNull a) => Factorial (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. Factorial 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. Factorial 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. Factorial m => m -> m
primeSuffix a
x)
   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. Factorial 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. Factorial 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. Factorial 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
   foldMap :: (Measured a -> n) -> Measured a -> n
foldMap Measured a -> n
f (Measured Int
_ a
x) = (a -> n) -> a -> n
forall m n. (Factorial 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
   length :: Measured a -> Int
length (Measured Int
n a
_) = Int
n
   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. Factorial m => m -> m
reverse a
x)

instance (StableFactorial a, FactorialMonoid a) => FactorialMonoid (Measured a) where
   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)
   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. Factorial 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. Factorial 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. Factorial 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

instance (StableFactorial a, MonoidNull a) => StableFactorial (Measured a)

instance (FactorialMonoid a, IsString a) => IsString (Measured a) where
   fromString :: String -> Measured a
fromString = a -> Measured a
forall a. Factorial 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, StableFactorial a, TextualMonoid a) => TextualMonoid (Measured a) where
   fromText :: Text -> Measured a
fromText = a -> Measured a
forall a. Factorial 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
   toText :: (Measured a -> Text) -> Measured a -> Text
toText Measured a -> Text
ft (Measured Int
_ a
x) = (a -> Text) -> a -> Text
forall t. TextualMonoid t => (t -> Text) -> t -> Text
toText (Measured a -> Text
ft (Measured a -> Text) -> (a -> Measured a) -> a -> Text
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. Factorial 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. Factorial 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