{-# 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)
data Measured a = Measured{Measured a -> Int
_measuredLength :: Int, :: 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)
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