packages feed

folds 0.3 → 0.5.0.1

raw patch · 9 files changed

+197/−45 lines, 9 filesdep +transformersdep ~comonaddep ~lensdep ~pointed

Dependencies added: transformers

Dependency ranges changed: comonad, lens, pointed, profunctors, semigroupoids

Files

CHANGELOG.markdown view
@@ -1,3 +1,11 @@+0.5.0.1+-------+* Restore compatibility with GHC < 7.8++0.5+---+* `lens` 4 compatibility+ 0.1 --- * Repository Initialized
folds.cabal view
@@ -1,6 +1,6 @@ name:          folds category:      Data, Comonads, Enumerator-version:       0.3+version:       0.5.0.1 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -51,14 +51,15 @@ library   build-depends:     base              >= 4     && < 5,-    comonad           >= 3.1   && < 4,+    comonad           >= 4     && < 5,     contravariant     >= 0.4.2 && < 1,-    lens              >= 3.9   && < 4,-    pointed           >= 3     && < 4,-    profunctors       >= 3.3   && < 4,+    lens              >= 4     && < 5,+    pointed           >= 4     && < 5,+    profunctors       >= 4     && < 5,     reflection        >= 1.3   && < 2,-    semigroupoids     >= 3.1   && < 4,+    semigroupoids     >= 4     && < 5,     tagged            >= 0.7   && < 1,+    transformers      >= 0.3   && < 0.4,     vector            >= 0.10  && < 0.11    hs-source-dirs: src
src/Data/Fold.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DefaultSignatures #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2009-2013 Edward Kmett@@ -17,21 +18,25 @@   , beneath   -- * Scans   -- ** Left Scans-  , L1(..), L1'(..)+  , L1(..)  -- lazy Mealy machine+  , L1'(..) -- strict Mealy machine   -- ** Semigroup Scans-  , M1(..)+  , M1(..) -- semigroup reducer   -- ** Right Scans-  , R1(..)+  , R1(..) -- reversed lazy Mealy machine   -- * Foldings   -- ** Left Foldings-  , L(..), L'(..)+  , L(..) -- lazy Moore machine+  , L'(..) -- strict Moore machine   -- ** Monoidal Foldings-  , M(..)+  , M(..) -- monoidal reducer   -- ** Right Foldings-  , R(..)+  , R(..) -- reversed lazy Moore machine   -- * Homomorphisms   -- ** Scan Homomorphisms   -- $scanhom+  , AsRM1(..)+  , AsL1'(..)    -- ** Folding Homomorphisms   -- $foldinghom@@ -40,6 +45,7 @@   ) where  import Data.Fold.Class+import Data.Fold.Internal import Data.Fold.L import Data.Fold.L' import Data.Fold.L1@@ -75,8 +81,9 @@ -- Furthermore, -- -- @'left'' (f φ)@ and @f ('left'' φ)@ should agree whenever either answer is 'Right'--- @'right'' (f φ)@ and @f ('right'' φ)@ should agree whenver either answer is 'Left' --+-- @'right'' (f φ)@ and @f ('right'' φ)@ should agree whenever either answer is 'Left'+--  -- * Folding Homomorphisms @@ -99,7 +106,44 @@ -- Note: A law including 'extend' is explicitly excluded. To work consistenly -- across foldings, use 'prefix' and 'postfix' instead. -class AsRM p where+class AsRM1 p where+  -- | 'asM1' is a scan homomorphism to a semigroup reducer+  asM1 :: p a b -> M1 a b+  asM1 = asM1.asR1++  -- | 'asM1' is a scan homomorphism to a right scan+  asR1 :: p a b -> R1 a b+  asR1 = asR1.asM1++instance AsRM1 L where+  asM1 (L k h z) = M1 (\f -> k (f z)) (flip h) (>>>)++instance AsRM1 L' where+  asR1 (L' k h z) = R1 (\f -> k (f z)) (\b g x -> g $! h x b) (\a x -> h x a)++instance AsRM1 L1 where+  asM1 (L1 k h z) = M1 (\(Pair' _ r) -> k r) (\a -> Pair' (`h` a) (z a)) (\(Pair' r2r' r') (Pair' r2r _) -> Pair' (r2r.r2r') (r2r r'))++instance AsRM1 L1' where+  asM1 (L1' k h z) = M1 (\(Pair' _ r) -> k r) (\a -> Pair' (`h` a) (z a)) (\(Pair' r2r' r') (Pair' r2r _) -> Pair' (\r -> r2r $! r2r' r) (r2r r'))++instance AsRM1 M where+  asM1 (M k h m _) = M1 k h m+  asR1 (M k h m _) = R1 k (m.h) h++instance AsRM1 M1 where+  asM1 = id+  asR1 (M1 k h m) = R1 k (m.h) h++instance AsRM1 R where+  asM1 (R k h z) = M1 (\f -> k (f z)) h (.)+  asR1 (R k h z) = R1 k h (\a -> h a z)++instance AsRM1 R1 where+  asM1 (R1 k h z) = M1 (\(Pair' _ r) -> k r) (\a -> Pair' (h a) (z a)) (\(Pair' r2r _) (Pair' r2r' r') -> Pair' (r2r.r2r') (r2r r'))+  asR1 = id++class AsRM1 p => AsRM p where   -- | 'asM' is a folding homomorphism to a monoidal folding   --   -- @@@ -151,7 +195,7 @@  -- | We can convert from a monoidal fold to a lazy right fold instance AsRM M where-  asR (M k h m z) = R k (m . h) z+  asR (M k h m z) = R k (m.h) z   asM = id  -- | We can convert from a lazy left folding to a right or monoidal fold@@ -163,7 +207,25 @@ instance AsRM L' where   asR (L' k h z) = R (\f -> k (f z)) (\b g x -> g $! h x b) id -class AsL' p where+class AsRM1 p => AsL1' p where+  -- | Scan homomorphism to a strict Mealy machine+  asL1' :: p a b -> L1' a b+  default asL1' :: AsL' p => p a b -> L1' a b+  asL1' = asL1'.asL'++instance AsL1' L1' where+  asL1' = id++instance AsL1' L1 where+  asL1' (L1 k h z) = L1' (\(Box r) -> k r) (\(Box r) a -> Box (h r a)) (\a -> Box (z a))++instance AsL1' L where+  asL1' (L k h z) = L1' (\(Box r) -> k r) (\(Box r) a -> Box (h r a)) (\a -> Box (h z a))++instance AsL1' L' where+  asL1' (L' k h z) = L1' k h (h z)++class (AsRM p, AsL1' p) => AsL' p where   -- | 'asL'' is a folding homomorphism to a strict left folding   --   -- @@@ -192,5 +254,3 @@ -- | We can convert from a lazy left folding to a strict left folding. instance AsL' L where   asL' (L k h z) = L' (\(Box r) -> k r) (\(Box r) a -> Box (h r a)) (Box z)--data Box a = Box a
src/Data/Fold/Class.hs view
@@ -8,34 +8,29 @@   ) where  import Control.Lens-import Control.Lens.Internal.Setter import Data.Foldable+import Data.Fold.Internal import Data.Profunctor.Unsafe  -- -- $setup -- >>> import Data.Fold -newtype One a = One a--instance Foldable One where-  foldMap f (One a) = f a- class Choice p => Scan p where   prefix1 :: a -> p a b -> p a b   default prefix1 :: Folding p => a -> p a b -> p a b-  prefix1 = prefix . One+  prefix1 = prefix . An   {-# INLINE prefix1 #-}    postfix1 :: p a b -> a -> p a b   default postfix1 :: Folding p => p a b -> a -> p a b-  postfix1 p = postfix p . One+  postfix1 p = postfix p . An   {-# INLINE postfix1 #-}    -- | Apply a 'Folding' to a single element of input   run1 :: a -> p a b -> b   default run1 :: Folding p => a -> p a b -> b-  run1 = run . One+  run1 = run . An   {-# INLINE run1 #-}    interspersing :: a -> p a b -> p a b@@ -88,5 +83,5 @@ -- beneath :: Prism s t a b -> p a b -> p s t -- beneath :: Iso s t a b   -> p a b -> p s t -- @-beneath :: Profunctor p => Overloaded p Mutator s t a b -> p a b -> p s t-beneath l f = runMutator #. l (Mutator #. f)+beneath :: Profunctor p => Optic p Identity s t a b -> p a b -> p s t+beneath l f = runIdentity #. l (Identity #. f)
src/Data/Fold/Internal.hs view
@@ -4,17 +4,22 @@ {-# LANGUAGE DeriveDataTypeable #-} module Data.Fold.Internal   ( SnocList(..)+  , SnocList1(..)+  , List1(..)   , Maybe'(..), maybe'   , Pair'(..)   , N(..)   , Tree(..)+  , Tree1(..)+  , An(..)+  , Box(..)   ) where  import Control.Applicative-import Data.Data+import Data.Data (Data, Typeable) import Data.Foldable-import Data.Monoid-import Data.Proxy+import Data.Monoid hiding (First, Last)+import Data.Proxy (Proxy(Proxy)) import Data.Reflection import Data.Traversable @@ -25,6 +30,7 @@ instance Functor SnocList where   fmap f (Snoc xs x) = Snoc (fmap f xs) (f x)   fmap _ Nil = Nil+  {-# INLINABLE fmap #-}  instance Foldable SnocList where   foldl f z m0 = go m0 where@@ -33,13 +39,41 @@   {-# INLINE foldl #-}   foldMap f (Snoc xs x) = foldMap f xs `mappend` f x   foldMap _ Nil = mempty-  {-# INLINE foldMap #-}+  {-# INLINABLE foldMap #-}  instance Traversable SnocList where   traverse f (Snoc xs x) = Snoc <$> traverse f xs <*> f x   traverse _ Nil = pure Nil-  {-# INLINE traverse #-}+  {-# INLINABLE traverse #-} +data SnocList1 a = Snoc1 (SnocList1 a) a | First a+  deriving (Eq,Ord,Show,Read,Typeable,Data)++instance Functor SnocList1 where+  fmap f (Snoc1 xs x) = Snoc1 (fmap f xs) (f x)+  fmap f (First a) = First (f a)+  {-# INLINABLE fmap #-}++instance Foldable SnocList1 where+  foldl f z m0 = go m0 where+    go (Snoc1 xs x) = f (go xs) x+    go (First a) = f z a+  {-# INLINE foldl #-}+  foldl1 f m0 = go m0 where+    go (Snoc1 xs x) = f (go xs) x+    go (First a) = a+  {-# INLINE foldl1 #-}+  foldMap f (Snoc1 xs x) = foldMap f xs `mappend` f x+  foldMap f (First a) = f a+  {-# INLINABLE foldMap #-}++instance Traversable SnocList1 where+  traverse f (Snoc1 xs x) = Snoc1 <$> traverse f xs <*> f x+  traverse f (First a) = First <$> f a+  {-# INLINABLE traverse #-}+++ -- | Strict 'Maybe' data Maybe' a = Nothing' | Just' !a   deriving (Eq,Ord,Show,Read,Typeable,Data)@@ -86,11 +120,73 @@   traverse f (Two a b) = Two <$> traverse f a <*> traverse f b  -- | Strict Pair-data Pair' a b = Pair' !a !b-  deriving (Eq,Ord,Show,Read,Typeable,Data)+data Pair' a b = Pair' !a !b deriving (Eq,Ord,Show,Read,Typeable,Data)  instance (Monoid a, Monoid b) => Monoid (Pair' a b) where   mempty = Pair' mempty mempty   {-# INLINE mempty #-}   mappend (Pair' a b) (Pair' c d) = Pair' (mappend a c) (mappend b d)   {-# INLINE mappend #-}++newtype An a = An a deriving (Eq,Ord,Show,Read,Typeable,Data)++instance Functor An where+  fmap f (An a) = An (f a)++instance Foldable An where+  foldMap f (An a) = f a++instance Traversable An where+  traverse f (An a) = An <$> f a++data Box a = Box a deriving (Eq,Ord,Show,Read,Typeable,Data)++instance Functor Box where+  fmap f (Box a) = Box (f a)++instance Foldable Box where+  foldMap f (Box a) = f a++instance Traversable Box where+  traverse f (Box a) = Box <$> f a++data List1 a = Cons1 a (List1 a) | Last a++instance Functor List1 where+  fmap f (Cons1 a as) = Cons1 (f a) (fmap f as)+  fmap f (Last a) = Last (f a)++instance Foldable List1 where+  foldMap f = go where+    go (Cons1 a as) = f a `mappend` foldMap f as+    go (Last a) = f a+  {-# INLINE foldMap #-}++  foldr f z = go where+    go (Cons1 a as) = f a (go as)+    go (Last a) = f a z+  {-# INLINE foldr #-}++  foldr1 f = go where+    go (Cons1 a as) = f a (go as)+    go (Last a)     = a+  {-# INLINE foldr1 #-}++instance Traversable List1 where+  traverse f (Cons1 a as) = Cons1 <$> f a <*> traverse f as+  traverse f (Last a) = Last <$> f a+  {-# INLINABLE traverse #-}++data Tree1 a = Bin1 (Tree1 a) (Tree1 a) | Tip1 a++instance Functor Tree1 where+  fmap f (Bin1 as bs) = Bin1 (fmap f as) (fmap f bs)+  fmap f (Tip1 a) = Tip1 (f a)++instance Foldable Tree1 where+  foldMap f (Bin1 as bs) = foldMap f as `mappend` foldMap f bs+  foldMap f (Tip1 a) = f a++instance Traversable Tree1 where+  traverse f (Bin1 as bs) = Bin1 <$> traverse f as <*> traverse f bs+  traverse f (Tip1 a) = Tip1 <$> f a
src/Data/Fold/L1'.hs view
@@ -141,8 +141,6 @@     step _ (Left c) = Left c   {-# INLINE right #-} -data SnocList1 a = Snoc1 (SnocList1 a) a | First a- walk :: SnocList1 a -> L1' a b -> b walk xs0 (L1' k h z) = k (go xs0) where   go (First a) = z a
src/Data/Fold/L1.hs view
@@ -141,8 +141,6 @@     step _ (Left c) = Left c   {-# INLINE right #-} -data SnocList1 a = Snoc1 (SnocList1 a) a | First a- walk :: SnocList1 a -> L1 a b -> b walk xs0 (L1 k h z) = k (go xs0) where   go (First a) = z a
src/Data/Fold/M1.hs view
@@ -144,8 +144,6 @@     step _ (Left c) = Left c   {-# INLINE right #-} -data Tree1 a = Bin1 (Tree1 a) (Tree1 a) | Tip1 a- walk :: Tree1 a -> M1 a b -> b walk xs0 (M1 k h m) = k (go xs0) where   go (Tip1 a) = h a
src/Data/Fold/R1.hs view
@@ -90,7 +90,7 @@   second (R1 k h z) = R1 (second k) h' (second z) where     h' (a,b) (_,c) = (a, h b c)   {-# INLINE second #-}-  R1 k h z *** R1 k' h' z' = R1 (k *** k') h'' (z *** z') where +  R1 k h z *** R1 k' h' z' = R1 (k *** k') h'' (z *** z') where     h'' (a,b) (c,d) = (h a c, h' b d)   {-# INLINE (***) #-}   R1 k h z &&& R1 k' h' z' = R1 (k *** k') h'' (z &&& z') where@@ -140,8 +140,6 @@     step (Left c) _ = Left c     step _ (Left c) = Left c   {-# INLINE right #-}--data List1 a = Cons1 a (List1 a) | Last a  walk :: List1 a -> R1 a b -> b walk xs0 (R1 k h z) = k (go xs0) where