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