{- 
    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 x :: 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 _ x :: a
x) (Measured _ y :: 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 m :: Int
m a :: a
a <> :: Measured a -> Measured a -> Measured a
<> Measured n :: Int
n b :: 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 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 n :: Int
n _) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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 m :: Int
m x :: a
x) (Measured n :: Int
n y :: 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 m :: Int
m x :: a
x) (Measured n :: Int
n y :: 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 _ x :: a
x) (Measured _ y :: 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 _ x :: a
x) (Measured _ y :: 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 _ x :: 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 1) (a -> [a]
forall m. Factorial m => m -> [m]
factors a
x)
   primePrefix :: Measured a -> Measured a
primePrefix m :: Measured a
m@(Measured _ x :: 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 1 (a -> a
forall m. Factorial m => m -> m
primePrefix a
x)
   primeSuffix :: Measured a -> Measured a
primeSuffix m :: Measured a
m@(Measured _ x :: 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 1 (a -> a
forall m. Factorial m => m -> m
primeSuffix a
x)
   foldl :: (a -> Measured a -> a) -> a -> Measured a -> a
foldl f :: a -> Measured a -> a
f a0 :: a
a0 (Measured _ x :: 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 = 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 1
   foldl' :: (a -> Measured a -> a) -> a -> Measured a -> a
foldl' f :: a -> Measured a -> a
f a0 :: a
a0 (Measured _ x :: 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 = 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 1
   foldr :: (Measured a -> a -> a) -> a -> Measured a -> a
foldr f :: Measured a -> a -> a
f a0 :: a
a0 (Measured _ x :: 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 1
   foldMap :: (Measured a -> n) -> Measured a -> n
foldMap f :: Measured a -> n
f (Measured _ x :: 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 1) a
x
   length :: Measured a -> Int
length (Measured n :: Int
n _) = Int
n
   reverse :: Measured a -> Measured a
reverse (Measured n :: Int
n x :: 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 n :: Int
n x :: a
x) = case a -> Maybe (a, a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimePrefix a
x
                                     of Nothing -> Maybe (Measured a, Measured a)
forall a. Maybe a
Nothing
                                        Just (p :: a
p, s :: 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 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
- 1) a
s)
   splitPrimeSuffix :: Measured a -> Maybe (Measured a, Measured a)
splitPrimeSuffix (Measured n :: Int
n x :: a
x) = case a -> Maybe (a, a)
forall m. FactorialMonoid m => m -> Maybe (m, m)
splitPrimeSuffix a
x
                                     of Nothing -> Maybe (Measured a, Measured a)
forall a. Maybe a
Nothing
                                        Just (p :: a
p, s :: 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
- 1) a
p, Int -> a -> Measured a
forall a. Int -> a -> Measured a
Measured 1 a
s)
   span :: (Measured a -> Bool) -> Measured a -> (Measured a, Measured a)
span p :: Measured a -> Bool
p (Measured n :: Int
n x :: a
x) = (Measured a
xp', Measured a
xs')
      where (xp :: a
xp, xs :: 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 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 p :: Measured a -> Bool
p (Measured _ x :: 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 1) a
x
   splitAt :: Int -> Measured a -> (Measured a, Measured a)
splitAt m :: Int
m (Measured n :: Int
n x :: a
x) | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 (xp :: a
xp, xs :: 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 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 n :: Int
n x :: 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
- 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 _ x :: a
x) = a -> Maybe Char
forall t. TextualMonoid t => t -> Maybe Char
characterPrefix a
x
   map :: (Char -> Char) -> Measured a -> Measured a
map f :: Char -> Char
f (Measured n :: Int
n x :: 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 p :: Char -> Bool
p (Measured _ x :: 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 p :: Char -> Bool
p (Measured _ x :: 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 ft :: a -> Measured a -> a
ft fc :: a -> Char -> a
fc a0 :: a
a0 (Measured _ x :: 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-> 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 1) a -> Char -> a
fc a
a0 a
x
   foldl' :: (a -> Measured a -> a) -> (a -> Char -> a) -> a -> Measured a -> a
foldl' ft :: a -> Measured a -> a
ft fc :: a -> Char -> a
fc a0 :: a
a0 (Measured _ x :: 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-> 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 1) a -> Char -> a
fc a
a0 a
x
   foldr :: (Measured a -> a -> a) -> (Char -> a -> a) -> a -> Measured a -> a
foldr ft :: Measured a -> a -> a
ft fc :: Char -> a -> a
fc a0 :: a
a0 (Measured _ x :: 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 1) Char -> a -> a
fc a
a0 a
x
   toString :: (Measured a -> String) -> Measured a -> String
toString ft :: Measured a -> String
ft (Measured _ x :: 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 1) a
x

   span :: (Measured a -> Bool)
-> (Char -> Bool) -> Measured a -> (Measured a, Measured a)
span pt :: Measured a -> Bool
pt pc :: Char -> Bool
pc (Measured n :: Int
n x :: a
x) = (Measured a
xp', Measured a
xs')
      where (xp :: a
xp, xs :: 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 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 pt :: Measured a -> Bool
pt pc :: 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 p :: Char -> Bool
p (Measured _ x :: a
x) = (Char -> Bool) -> a -> Maybe Char
forall t. TextualMonoid t => (Char -> Bool) -> t -> Maybe Char
find Char -> Bool
p a
x