{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, TypeOperators, ScopedTypeVariables, CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#ifndef MIN_VERSION_semigroups
#define MIN_VERSION_semigroups(x,y,z) 1
#endif
module Data.Semigroup.Reducer
( Reducer(..)
, foldMapReduce, foldMapReduce1
, foldReduce, foldReduce1
, pureUnit
, returnUnit
, Count(..)
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import qualified Data.Monoid as Monoid
import Data.Semigroup as Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Instances ()
import Data.Hashable
#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
#endif
import Data.FingerTree
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.HashMap.Lazy as HashMap
import Data.HashMap.Lazy (HashMap)
#ifdef LANGUAGE_DeriveDataTypeable
import Data.Data
#endif
class Semigroup m => Reducer c m where
unit :: c -> m
snoc :: m -> c -> m
cons :: c -> m -> m
snoc m
m = forall a. Semigroup a => a -> a -> a
(<>) m
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c m. Reducer c m => c -> m
unit
cons = forall a. Semigroup a => a -> a -> a
(<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c m. Reducer c m => c -> m
unit
foldMapReduce :: (Foldable f, Monoid m, Reducer e m) => (a -> e) -> f a -> m
foldMapReduce :: forall (f :: * -> *) m e a.
(Foldable f, Monoid m, Reducer e m) =>
(a -> e) -> f a -> m
foldMapReduce a -> e
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall c m. Reducer c m => c -> m
unit forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
f)
foldMapReduce1 :: (Foldable1 f, Reducer e m) => (a -> e) -> f a -> m
foldMapReduce1 :: forall (f :: * -> *) e m a.
(Foldable1 f, Reducer e m) =>
(a -> e) -> f a -> m
foldMapReduce1 a -> e
f = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 (forall c m. Reducer c m => c -> m
unit forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
f)
foldReduce :: (Foldable f, Monoid m, Reducer e m) => f e -> m
foldReduce :: forall (f :: * -> *) m e.
(Foldable f, Monoid m, Reducer e m) =>
f e -> m
foldReduce = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall c m. Reducer c m => c -> m
unit
foldReduce1 :: (Foldable1 f, Reducer e m) => f e -> m
foldReduce1 :: forall (f :: * -> *) e m. (Foldable1 f, Reducer e m) => f e -> m
foldReduce1 = forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 forall c m. Reducer c m => c -> m
unit
returnUnit :: (Monad m, Reducer c n) => c -> m n
returnUnit :: forall (m :: * -> *) c n. (Monad m, Reducer c n) => c -> m n
returnUnit = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c m. Reducer c m => c -> m
unit
pureUnit :: (Applicative f, Reducer c n) => c -> f n
pureUnit :: forall (f :: * -> *) c n. (Applicative f, Reducer c n) => c -> f n
pureUnit = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c m. Reducer c m => c -> m
unit
newtype Count = Count { Count -> Int
getCount :: Int } deriving
( Count -> Count -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c== :: Count -> Count -> Bool
Eq, Eq Count
Count -> Count -> Bool
Count -> Count -> Ordering
Count -> Count -> Count
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Count -> Count -> Count
$cmin :: Count -> Count -> Count
max :: Count -> Count -> Count
$cmax :: Count -> Count -> Count
>= :: Count -> Count -> Bool
$c>= :: Count -> Count -> Bool
> :: Count -> Count -> Bool
$c> :: Count -> Count -> Bool
<= :: Count -> Count -> Bool
$c<= :: Count -> Count -> Bool
< :: Count -> Count -> Bool
$c< :: Count -> Count -> Bool
compare :: Count -> Count -> Ordering
$ccompare :: Count -> Count -> Ordering
Ord, Int -> Count -> ShowS
[Count] -> ShowS
Count -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Count] -> ShowS
$cshowList :: [Count] -> ShowS
show :: Count -> String
$cshow :: Count -> String
showsPrec :: Int -> Count -> ShowS
$cshowsPrec :: Int -> Count -> ShowS
Show, ReadPrec [Count]
ReadPrec Count
Int -> ReadS Count
ReadS [Count]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Count]
$creadListPrec :: ReadPrec [Count]
readPrec :: ReadPrec Count
$creadPrec :: ReadPrec Count
readList :: ReadS [Count]
$creadList :: ReadS [Count]
readsPrec :: Int -> ReadS Count
$creadsPrec :: Int -> ReadS Count
Read
#ifdef LANGUAGE_DeriveDataTypeable
, Typeable Count
Count -> Constr
Count -> DataType
(forall b. Data b => b -> b) -> Count -> Count
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Count -> u
forall u. (forall d. Data d => d -> u) -> Count -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Count -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Count -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Count -> m Count
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Count -> m Count
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Count
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Count -> c Count
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Count)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Count)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Count -> m Count
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Count -> m Count
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Count -> m Count
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Count -> m Count
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Count -> m Count
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Count -> m Count
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Count -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Count -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Count -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Count -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Count -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Count -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Count -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Count -> r
gmapT :: (forall b. Data b => b -> b) -> Count -> Count
$cgmapT :: (forall b. Data b => b -> b) -> Count -> Count
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Count)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Count)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Count)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Count)
dataTypeOf :: Count -> DataType
$cdataTypeOf :: Count -> DataType
toConstr :: Count -> Constr
$ctoConstr :: Count -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Count
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Count
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Count -> c Count
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Count -> c Count
Data, Typeable
#endif
)
instance Hashable Count where
hashWithSalt :: Int -> Count -> Int
hashWithSalt Int
n = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count -> Int
getCount
instance Semigroup Count where
Count Int
a <> :: Count -> Count -> Count
<> Count Int
b = Int -> Count
Count (Int
a forall a. Num a => a -> a -> a
+ Int
b)
#if MIN_VERSION_semigroups(0,17,0)
stimes :: forall b. Integral b => b -> Count -> Count
stimes b
n (Count Int
a) = Int -> Count
Count forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n forall a. Num a => a -> a -> a
* Int
a
#else
times1p n (Count a) = Count $ (fromIntegral n + 1) * a
#endif
instance Monoid Count where
mempty :: Count
mempty = Int -> Count
Count Int
0
#if !(MIN_VERSION_base(4,11,0))
Count a `mappend` Count b = Count (a + b)
#endif
instance Reducer a Count where
unit :: a -> Count
unit a
_ = Int -> Count
Count Int
1
Count Int
n snoc :: Count -> a -> Count
`snoc` a
_ = Int -> Count
Count (Int
n forall a. Num a => a -> a -> a
+ Int
1)
a
_ cons :: a -> Count -> Count
`cons` Count Int
n = Int -> Count
Count (Int
n forall a. Num a => a -> a -> a
+ Int
1)
instance (Reducer c m, Reducer c n) => Reducer c (m,n) where
unit :: c -> (m, n)
unit c
x = (forall c m. Reducer c m => c -> m
unit c
x,forall c m. Reducer c m => c -> m
unit c
x)
(m
m,n
n) snoc :: (m, n) -> c -> (m, n)
`snoc` c
x = (m
m forall c m. Reducer c m => m -> c -> m
`snoc` c
x, n
n forall c m. Reducer c m => m -> c -> m
`snoc` c
x)
c
x cons :: c -> (m, n) -> (m, n)
`cons` (m
m,n
n) = (c
x forall c m. Reducer c m => c -> m -> m
`cons` m
m, c
x forall c m. Reducer c m => c -> m -> m
`cons` n
n)
instance (Reducer c m, Reducer c n, Reducer c o) => Reducer c (m,n,o) where
unit :: c -> (m, n, o)
unit c
x = (forall c m. Reducer c m => c -> m
unit c
x,forall c m. Reducer c m => c -> m
unit c
x, forall c m. Reducer c m => c -> m
unit c
x)
(m
m,n
n,o
o) snoc :: (m, n, o) -> c -> (m, n, o)
`snoc` c
x = (m
m forall c m. Reducer c m => m -> c -> m
`snoc` c
x, n
n forall c m. Reducer c m => m -> c -> m
`snoc` c
x, o
o forall c m. Reducer c m => m -> c -> m
`snoc` c
x)
c
x cons :: c -> (m, n, o) -> (m, n, o)
`cons` (m
m,n
n,o
o) = (c
x forall c m. Reducer c m => c -> m -> m
`cons` m
m, c
x forall c m. Reducer c m => c -> m -> m
`cons` n
n, c
x forall c m. Reducer c m => c -> m -> m
`cons` o
o)
instance (Reducer c m, Reducer c n, Reducer c o, Reducer c p) => Reducer c (m,n,o,p) where
unit :: c -> (m, n, o, p)
unit c
x = (forall c m. Reducer c m => c -> m
unit c
x,forall c m. Reducer c m => c -> m
unit c
x, forall c m. Reducer c m => c -> m
unit c
x, forall c m. Reducer c m => c -> m
unit c
x)
(m
m,n
n,o
o,p
p) snoc :: (m, n, o, p) -> c -> (m, n, o, p)
`snoc` c
x = (m
m forall c m. Reducer c m => m -> c -> m
`snoc` c
x, n
n forall c m. Reducer c m => m -> c -> m
`snoc` c
x, o
o forall c m. Reducer c m => m -> c -> m
`snoc` c
x, p
p forall c m. Reducer c m => m -> c -> m
`snoc` c
x)
c
x cons :: c -> (m, n, o, p) -> (m, n, o, p)
`cons` (m
m,n
n,o
o,p
p) = (c
x forall c m. Reducer c m => c -> m -> m
`cons` m
m, c
x forall c m. Reducer c m => c -> m -> m
`cons` n
n, c
x forall c m. Reducer c m => c -> m -> m
`cons` o
o, c
x forall c m. Reducer c m => c -> m -> m
`cons` p
p)
instance Reducer c [c] where
unit :: c -> [c]
unit = forall (m :: * -> *) a. Monad m => a -> m a
return
cons :: c -> [c] -> [c]
cons = (:)
[c]
xs snoc :: [c] -> c -> [c]
`snoc` c
x = [c]
xs forall a. [a] -> [a] -> [a]
++ [c
x]
instance Reducer c () where
unit :: c -> ()
unit c
_ = ()
()
_ snoc :: () -> c -> ()
`snoc` c
_ = ()
c
_ cons :: c -> () -> ()
`cons` ()
_ = ()
instance Reducer Bool Any where
unit :: Bool -> Any
unit = Bool -> Any
Any
instance Reducer Bool All where
unit :: Bool -> All
unit = Bool -> All
All
instance Reducer (a -> a) (Endo a) where
unit :: (a -> a) -> Endo a
unit = forall a. (a -> a) -> Endo a
Endo
instance Semigroup a => Reducer a (Dual a) where
unit :: a -> Dual a
unit = forall a. a -> Dual a
Dual
instance Num a => Reducer a (Sum a) where
unit :: a -> Sum a
unit = forall a. a -> Sum a
Sum
instance Num a => Reducer a (Product a) where
unit :: a -> Product a
unit = forall a. a -> Product a
Product
instance Ord a => Reducer a (Min a) where
unit :: a -> Min a
unit = forall a. a -> Min a
Min
instance Ord a => Reducer a (Max a) where
unit :: a -> Max a
unit = forall a. a -> Max a
Max
instance Reducer (Maybe a) (Monoid.First a) where
unit :: Maybe a -> First a
unit = forall a. Maybe a -> First a
Monoid.First
instance Reducer a (Semigroup.First a) where
unit :: a -> First a
unit = forall a. a -> First a
Semigroup.First
instance Reducer (Maybe a) (Monoid.Last a) where
unit :: Maybe a -> Last a
unit = forall a. Maybe a -> Last a
Monoid.Last
instance Reducer a (Semigroup.Last a) where
unit :: a -> Last a
unit = forall a. a -> Last a
Semigroup.Last
instance Measured v a => Reducer a (FingerTree v a) where
unit :: a -> FingerTree v a
unit = forall v a. Measured v a => a -> FingerTree v a
singleton
cons :: a -> FingerTree v a -> FingerTree v a
cons = forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
(<|)
snoc :: FingerTree v a -> a -> FingerTree v a
snoc = forall v a. Measured v a => FingerTree v a -> a -> FingerTree v a
(|>)
instance Reducer a (Seq a) where
unit :: a -> Seq a
unit = forall a. a -> Seq a
Seq.singleton
cons :: a -> Seq a -> Seq a
cons = forall a. a -> Seq a -> Seq a
(Seq.<|)
snoc :: Seq a -> a -> Seq a
snoc = forall a. Seq a -> a -> Seq a
(Seq.|>)
instance Reducer Int IntSet where
unit :: Int -> IntSet
unit = Int -> IntSet
IntSet.singleton
cons :: Int -> IntSet -> IntSet
cons = Int -> IntSet -> IntSet
IntSet.insert
snoc :: IntSet -> Int -> IntSet
snoc = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> IntSet -> IntSet
IntSet.insert
instance Ord a => Reducer a (Set a) where
unit :: a -> Set a
unit = forall a. a -> Set a
Set.singleton
cons :: a -> Set a -> Set a
cons = forall a. Ord a => a -> Set a -> Set a
Set.insert
snoc :: Set a -> a -> Set a
snoc Set a
s a
m | forall a. Ord a => a -> Set a -> Bool
Set.member a
m Set a
s = Set a
s
| Bool
otherwise = forall a. Ord a => a -> Set a -> Set a
Set.insert a
m Set a
s
instance Reducer (Int, v) (IntMap v) where
unit :: (Int, v) -> IntMap v
unit = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Int -> a -> IntMap a
IntMap.singleton
cons :: (Int, v) -> IntMap v -> IntMap v
cons = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert
snoc :: IntMap v -> (Int, v) -> IntMap v
snoc = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IntMap.insertWith forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id
instance Ord k => Reducer (k, v) (Map k v) where
unit :: (k, v) -> Map k v
unit = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. k -> a -> Map k a
Map.singleton
cons :: (k, v) -> Map k v -> Map k v
cons = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert
snoc :: Map k v -> (k, v) -> Map k v
snoc = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id
instance (Eq k, Hashable k) => Reducer (k, v) (HashMap k v) where
unit :: (k, v) -> HashMap k v
unit = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton
cons :: (k, v) -> HashMap k v -> HashMap k v
cons = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert
snoc :: HashMap k v -> (k, v) -> HashMap k v
snoc = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id
instance Monoid m => Reducer m (WrappedMonoid m) where
unit :: m -> WrappedMonoid m
unit = forall m. m -> WrappedMonoid m
WrapMonoid