{- 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{_measuredLength :: Int, extract :: a} deriving (Eq, Show) -- | Create a new 'Measured' value. measure :: FactorialMonoid a => a -> Measured a measure x = Measured (length x) x instance Ord a => Ord (Measured a) where compare (Measured _ x) (Measured _ y) = compare x y instance StableFactorialMonoid a => Semigroup (Measured a) where Measured m a <> Measured n b = Measured (m + n) (mappend a b) instance StableFactorialMonoid a => Monoid (Measured a) where mempty = Measured 0 mempty mappend (Measured m a) (Measured n b) = Measured (m + n) (mappend a b) instance StableFactorialMonoid a => MonoidNull (Measured a) where null (Measured n _) = n == 0 instance StableFactorialMonoid a => PositiveMonoid (Measured a) instance (LeftReductiveMonoid a, StableFactorialMonoid a) => LeftReductiveMonoid (Measured a) where stripPrefix (Measured m x) (Measured n y) = fmap (Measured (n - m)) (stripPrefix x y) instance (RightReductiveMonoid a, StableFactorialMonoid a) => RightReductiveMonoid (Measured a) where stripSuffix (Measured m x) (Measured n y) = fmap (Measured (n - m)) (stripSuffix x y) instance (LeftGCDMonoid a, StableFactorialMonoid a) => LeftGCDMonoid (Measured a) where commonPrefix (Measured _ x) (Measured _ y) = measure (commonPrefix x y) instance (RightGCDMonoid a, StableFactorialMonoid a) => RightGCDMonoid (Measured a) where commonSuffix (Measured _ x) (Measured _ y) = measure (commonSuffix x y) instance StableFactorialMonoid a => FactorialMonoid (Measured a) where factors (Measured _ x) = List.map (Measured 1) (factors x) primePrefix m@(Measured _ x) = if null x then m else Measured 1 (primePrefix x) primeSuffix m@(Measured _ x) = if null x then m else Measured 1 (primeSuffix x) splitPrimePrefix (Measured n x) = case splitPrimePrefix x of Nothing -> Nothing Just (p, s) -> Just (Measured 1 p, Measured (n - 1) s) splitPrimeSuffix (Measured n x) = case splitPrimeSuffix x of Nothing -> Nothing Just (p, s) -> Just (Measured (n - 1) p, Measured 1 s) foldl f a0 (Measured _ x) = Factorial.foldl g a0 x where g a = f a . Measured 1 foldl' f a0 (Measured _ x) = Factorial.foldl' g a0 x where g a = f a . Measured 1 foldr f a0 (Measured _ x) = Factorial.foldr g a0 x where g = f . Measured 1 length (Measured n _) = n foldMap f (Measured _ x) = Factorial.foldMap (f . Measured 1) x span p (Measured n x) = (xp', xs') where (xp, xs) = Factorial.span (p . Measured 1) x xp' = measure xp xs' = Measured (n - length xp') xs split p (Measured _ x) = measure <$> Factorial.split (p . Measured 1) x splitAt m (Measured n x) | m <= 0 = (mempty, Measured n x) | m >= n = (Measured n x, mempty) | otherwise = (Measured m xp, Measured (n - m) xs) where (xp, xs) = splitAt m x reverse (Measured n x) = Measured n (reverse x) instance StableFactorialMonoid a => StableFactorialMonoid (Measured a) instance (FactorialMonoid a, IsString a) => IsString (Measured a) where fromString = measure . fromString instance (Eq a, TextualMonoid a, StableFactorialMonoid a) => TextualMonoid (Measured a) where fromText = measure . fromText singleton = Measured 1 . singleton splitCharacterPrefix (Measured n x) = (Measured (n - 1) <$>) <$> splitCharacterPrefix x characterPrefix (Measured _ x) = characterPrefix x map f (Measured n x) = Measured n (map f x) any p (Measured _ x) = any p x all p (Measured _ x) = all p x foldl ft fc a0 (Measured _ x) = Textual.foldl (\a-> ft a . Measured 1) fc a0 x foldl' ft fc a0 (Measured _ x) = Textual.foldl' (\a-> ft a . Measured 1) fc a0 x foldr ft fc a0 (Measured _ x) = Textual.foldr (ft . Measured 1) fc a0 x toString ft (Measured _ x) = toString (ft . Measured 1) x span pt pc (Measured n x) = (xp', xs') where (xp, xs) = Textual.span (pt . Measured 1) pc x xp' = measure xp xs' = Measured (n - length xp') xs break pt pc = Textual.span (not . pt) (not . pc) find p (Measured _ x) = find p x