hs-functors 0.1.1.0 → 0.1.2.0

raw patch · 8 files changed

+315/−1 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Comonad/Cofree.hs +76/−0
• Control/Monad/Free.hs +81/−0
• Data/Bicotraversable.hs +21/−0
• Data/Bifunctor/Biff.hs +34/−0
• Data/Bifunctor/Tannen.hs +29/−0
• Data/Fix.hs +39/−0
• Data/Functor/Join.hs +23/−0
• hs-functors.cabal +12/−1

@@ -0,0 +1,76 @@+module Control.Comonad.Cofree where++import Prelude hiding ((.), id, map)++import Control.Applicative+import Control.Category+import Control.Comonad+import Control.Monad+import Data.Cotraversable+import Data.Functor.Classes+import Data.Profunctor+import Data.Semigroup ((<>))+import Text.Read (Read (..))++data Cofree f a = Cofree a (f (Cofree f a))+  deriving (Functor, Foldable, Traversable)++instance Alternative f => Applicative (Cofree f) where+    pure = flip Cofree empty+    (<*>) = ap++instance Alternative f => Monad (Cofree f) where+    x >>= f = join (f <$> x) where join (Cofree (Cofree a s) t) = Cofree a (s <|> join <$> t)++instance Functor f => Comonad (Cofree f) where+    copure (Cofree a _) = a+    cut ɯ@(Cofree _ t) = Cofree ɯ (cut <$> t)++instance Cotraversable f => Cotraversable (Cofree f) where+    cosequence = Cofree <$> fmap (\ (Cofree a _) -> a)+                        <*> fmap cosequence . collect (\ (Cofree _ t) -> t)++instance Eq1 f => Eq1 (Cofree f) where+    liftEq (==) (Cofree a s) (Cofree b t) = a == b && (liftEq . liftEq) (==) s t++instance Ord1 f => Ord1 (Cofree f) where+    liftCompare cmp (Cofree a s) (Cofree b t) = a `cmp` b <> (liftCompare . liftCompare) cmp s t++instance Read1 f => Read1 (Cofree f) where+    liftReadPrec rp rl =+        readBinaryWith rp (liftReadPrec (liftReadPrec rp rl)+                                        (liftReadListPrec rp rl)) "Cofree"  Cofree++instance Show1 f => Show1 (Cofree f) where+    liftShowsPrec sp sl n (Cofree a t) =+        showsBinaryWith sp (liftShowsPrec (liftShowsPrec sp sl)+                                          (liftShowList sp sl)) "Cofree" n a t++instance (Eq1 f, Eq a) => Eq (Cofree f a) where (==) = eq1+instance (Ord1 f, Ord a) => Ord (Cofree f a) where compare = compare1+instance (Read1 f, Read a) => Read (Cofree f a) where readPrec = readPrec1+instance (Show1 f, Show a) => Show (Cofree f a) where showsPrec = showsPrec1++raise :: Comonad ɯ => ɯ a -> Cofree ɯ a+raise = liftA2 Cofree copure (raise <<=)++lower :: Functor ɯ => Cofree ɯ a -> ɯ a+lower (Cofree _ t) = copure <$> t++coiter :: Functor f => (a -> f a) -> a -> Cofree f a+coiter f = unfold (id &&& f)++coiterW :: (Comonad ɯ, Functor f) => (ɯ a -> f (ɯ a)) -> ɯ a -> Cofree f a+coiterW f ɯ = copure ɯ `Cofree` (coiterW f <$> f ɯ)++unfold :: Functor f => (a -> (b, f a)) -> a -> Cofree f b+unfold f = f >>> \ (b, af) -> Cofree b (unfold f <$> af)++unfoldM :: (Traversable f, Monad m) => (a -> m (b, f a)) -> a -> m (Cofree f b)+unfoldM f = f >=> \ (b, af) -> Cofree b <$> unfoldM f `traverse` af++unfoldW :: (Cotraversable f, Comonad ɯ) => (ɯ a -> (b, f a)) -> ɯ a -> Cofree f b+unfoldW f = f =>= \ ɯ -> Cofree (fst (copure ɯ)) (unfoldW f `cotraverse` (snd <$> ɯ))++map :: Functor f => (∀ a . f a -> g a) -> Cofree f a -> Cofree g a+map f (Cofree a t) = Cofree a (f (map f <$> t))

@@ -0,0 +1,81 @@+module Control.Monad.Free where++import Prelude hiding (map)++import Control.Applicative+import Control.Comonad+import Control.Monad+import Data.Cotraversable+import Data.Functor.Classes++data Free f a = Pure a | Free (f (Free f a))+  deriving (Functor, Foldable, Traversable)++instance Functor f => Applicative (Free f) where+    pure = Pure+    Pure a <*> Pure b = Pure (a b)+    Pure a <*> Free t = Free (fmap a <$> t)+    Free s <*> y      = Free ((<*> y) <$> s)++instance Functor f => Monad (Free f) where+    Pure a >>= f = f a+    Free t >>= f = Free ((>>= f) <$> t)++instance Eq1 f => Eq1 (Free f) where+    liftEq (==) = (≡)+      where Pure a ≡ Pure b = a == b+            Free s ≡ Free t = liftEq (≡) s t+            _      ≡ _      = False++instance Ord1 f => Ord1 (Free f) where+    liftCompare compare = cmp+      where Pure a `cmp` Pure b = a `compare` b+            Pure _ `cmp` Free _ = LT+            Free _ `cmp` Pure _ = GT+            Free s `cmp` Free t = liftCompare cmp s t++instance Read1 f => Read1 (Free f) where+    liftReadPrec rp rl =+        readUnaryWith rp                                      "Pure" Pure <|>+        readUnaryWith (liftReadPrec (liftReadPrec rp rl)+                                    (liftReadListPrec rp rl)) "Free" Free++instance Show1 f => Show1 (Free f) where+    liftShowsPrec sp sl n = \ case+        Pure a -> showsUnaryWith sp                                   "Pure" n a+        Free t -> showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl)+                                                (liftShowList sp sl)) "Free" n t++instance (Eq a, Eq1 f) => Eq (Free f a) where (==) = liftEq (==)+instance (Ord a, Ord1 f) => Ord (Free f a) where compare = liftCompare compare+instance (Read a, Read1 f) => Read (Free f a) where readsPrec = readsPrec1+instance (Show a, Show1 f) => Show (Free f a) where showsPrec = showsPrec1++lift :: Functor f => f a -> Free f a+lift = Free . fmap Pure++map :: Functor g => (∀ a . f a -> g a) -> Free f a -> Free g a+map _ (Pure a) = Pure a+map f (Free t) = Free (map f <$> f t)++fold :: Monad m => (∀ a . f a -> m a) -> Free f a -> m a+fold _ (Pure a) = pure a+fold f (Free t) = f t >>= fold f++iter :: Functor f => (f a -> a) -> Free f a -> a+iter _ (Pure a) = a+iter f (Free t) = f (iter f <$> t)++iterA :: (Functor f, Applicative p) => (f (p a) -> p a) -> Free f a -> p a+iterA _ (Pure a) = pure a+iterA f (Free t) = f (iterA f <$> t)++unfold :: Functor f => (b -> Either a (f b)) -> b -> Free f a+unfold f = either Pure (Free . fmap (unfold f)) . f++unfoldM :: (Traversable f, Monad m) => (b -> m (Either a (f b))) -> b -> m (Free f a)+unfoldM f = f >=> either (pure . pure) (fmap Free . traverse (unfoldM f))++unfoldW :: (Cotraversable f, Comonad ɯ) => (ɯ b -> Either a (f b)) -> ɯ b -> Free f a+unfoldW f ɯ = case f ɯ of Left a -> Pure a+                          Right bf -> Free (unfoldW f `cotraverse` (bf <$ ɯ))

@@ -0,0 +1,21 @@+module Data.Bicotraversable where++import Control.Arrow+import Data.Bifunctor+import Data.Functor.Const++class Bifunctor f => Bicotraversable f where+    bicollect :: Functor g => (a -> f b c) -> g a -> f (g b) (g c)+    bicollect f = bicosequence . fmap f++    bicosequence :: Functor g => g (f a b) -> f (g a) (g b)+    bicosequence = bicotraverse id id++    bicotraverse :: Functor g => (g a -> b) -> (g c -> d) -> g (f a c) -> f b d+    bicotraverse f g = bimap f g . bicosequence++instance Bicotraversable (,) where+    bicotraverse f g = f . fmap fst &&& g . fmap snd++instance Bicotraversable Const where+    bicotraverse f _ = Const . f . fmap getConst

@@ -0,0 +1,34 @@+module Data.Bifunctor.Biff where++import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable+import Data.Bicotraversable+import Data.Cotraversable+import Data.Functor.Classes+import Text.Read (Read (..))++newtype Biff s f g a b = Biff { unBiff :: f a `s` g b }+  deriving (Functor, Foldable)+instance (Traversable (s (f a)), Traversable g) => Traversable (Biff s f g a) where+    traverse f = fmap Biff . (traverse . traverse) f . unBiff+instance (Eq2 s, Eq1 f, Eq1 g, Eq a, Eq b) => Eq (Biff s f g a b) where (==) = eq2+instance (Ord2 s, Ord1 f, Ord1 g, Ord a, Ord b) => Ord (Biff s f g a b) where compare = compare2+instance (Read2 s, Read1 f, Read1 g, Read a, Read b) => Read (Biff s f g a b) where readPrec = readPrec2+instance (Show2 s, Show1 f, Show1 g, Show a, Show b) => Show (Biff s f g a b) where showsPrec = showsPrec2+instance (Eq2 s, Eq1 f, Eq1 g) => Eq2 (Biff s f g) where+    liftEq2 f g (Biff x) (Biff y) = liftEq2 (liftEq f) (liftEq g) x y+instance (Ord2 s, Ord1 f, Ord1 g) => Ord2 (Biff s f g) where+    liftCompare2 f g (Biff x) (Biff y) = liftCompare2 (liftCompare f) (liftCompare g) x y+instance (Read2 s, Read1 f, Read1 g) => Read2 (Biff s f g) where+    liftReadPrec2 f fs g gs = Biff <$> liftReadPrec2 (liftReadPrec f fs) (liftReadListPrec f fs) (liftReadPrec g gs) (liftReadListPrec g gs)+instance (Show2 s, Show1 f, Show1 g) => Show2 (Biff s f g) where+    liftShowsPrec2 f fs g gs n = liftShowsPrec2 (liftShowsPrec f fs) (liftShowList f fs) (liftShowsPrec g gs) (liftShowList g gs) n . unBiff+instance (Bifunctor s, Functor f, Functor g) => Bifunctor (Biff s f g) where+    bimap f g = Biff . bimap (fmap f) (fmap g) . unBiff+instance (Bifoldable s, Foldable f, Foldable g) => Bifoldable (Biff s f g) where+    bifoldMap f g = bifoldMap (foldMap f) (foldMap g) . unBiff+instance (Bitraversable s, Traversable f, Traversable g) => Bitraversable (Biff s f g) where+    bitraverse f g = fmap Biff . bitraverse (traverse f) (traverse g) . unBiff+instance (Bicotraversable s, Cotraversable f, Cotraversable g) => Bicotraversable (Biff s f g) where+    bicotraverse f g = Biff . bicotraverse (cotraverse f) (cotraverse g) . fmap unBiff

@@ -0,0 +1,29 @@+module Data.Bifunctor.Tannen where++import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable+import Data.Bicotraversable+import Data.Cotraversable+import Data.Functor.Classes+import Text.Read (Read (..))++newtype Tannen f s a b = Tannen { unTannen :: f (s a b) }+  deriving (Functor, Foldable)+deriving instance (Traversable f, Traversable (s a)) => Traversable (Tannen f s a)+instance (Eq1 f, Eq2 s, Eq a, Eq b) => Eq (Tannen f s a b) where (==) = eq2+instance (Ord1 f, Ord2 s, Ord a, Ord b) => Ord (Tannen f s a b) where compare = compare2+instance (Read1 f, Read2 s, Read a, Read b) => Read (Tannen f s a b) where readPrec = readPrec2+instance (Show1 f, Show2 s, Show a, Show b) => Show (Tannen f s a b) where showsPrec = showsPrec2+instance (Eq1 f, Eq2 s) => Eq2 (Tannen f s) where liftEq2 f g (Tannen x) (Tannen y) = liftEq (liftEq2 f g) x y+instance (Ord1 f, Ord2 s) => Ord2 (Tannen f s) where liftCompare2 f g (Tannen x) (Tannen y) = liftCompare (liftCompare2 f g) x y+instance (Read1 f, Read2 s) => Read2 (Tannen f s) where liftReadPrec2 rpa rlpa rpb rlpb = Tannen <$> liftReadPrec (liftReadPrec2 rpa rlpa rpb rlpb) (liftReadListPrec2 rpa rlpa rpb rlpb)+instance (Show1 f, Show2 s) => Show2 (Tannen f s) where liftShowsPrec2 spa sla spb slb n = liftShowsPrec (liftShowsPrec2 spa sla spb slb) (liftShowList2 spa sla spb slb) n . unTannen+instance (Functor f, Bifunctor s) => Bifunctor (Tannen f s) where+    bimap f g = Tannen . fmap (bimap f g) . unTannen+instance (Foldable f, Bifoldable s) => Bifoldable (Tannen f s) where+    bifoldMap f g = foldMap (bifoldMap f g) . unTannen+instance (Traversable f, Bitraversable s) => Bitraversable (Tannen f s) where+    bitraverse f g = fmap Tannen . traverse (bitraverse f g) . unTannen+instance (Cotraversable f, Bicotraversable s) => Bicotraversable (Tannen f s) where+    bicotraverse f g = Tannen . cotraverse (bicotraverse f g) . fmap unTannen

@@ -0,0 +1,39 @@+{-# LANGUAGE RankNTypes #-}++module Data.Fix where++import Control.Arrow+import Control.Comonad+import Control.Monad+import Data.Cotraversable+import Data.Function (on)+import Data.Functor.Classes+import Text.Read++newtype Fix f = Fix { unFix :: f (Fix f) }++instance Eq1 f => Eq (Fix f) where (==) = eq1 `on` unFix+instance Ord1 f => Ord (Fix f) where compare = compare1 `on` unFix+instance Read1 f => Read (Fix f) where readPrec = Fix <$> readPrec1+instance Show1 f => Show (Fix f) where showsPrec n = showsPrec1 n . unFix++mapFix :: Functor f => (∀ a . f a -> g a) -> Fix f -> Fix g+mapFix f = Fix . f . fmap (mapFix f) . unFix++cata :: Functor f => (f a -> a) -> Fix f -> a+cata f = f . fmap (cata f) . unFix++cataM :: (Traversable f, Monad m) => (f a -> m a) -> Fix f -> m a+cataM f = f <=< traverse (cataM f) <<< unFix++cataW :: (Cotraversable f, Comonad ɯ) => (ɯ (f a) -> a) -> ɯ (Fix f) -> a+cataW f = f =<= cotraverse (cataW f) <<< fmap unFix++ana :: Functor f => (a -> f a) -> a -> Fix f+ana f = Fix . fmap (ana f) . f++anaM :: (Traversable f, Monad m) => (a -> m (f a)) -> a -> m (Fix f)+anaM f = fmap Fix <<< traverse (anaM f) <=< f++anaW :: (Cotraversable f, Comonad ɯ) => (ɯ a -> f a) -> ɯ a -> Fix f+anaW f = Fix <<< cotraverse (anaW f) =<= f

@@ -0,0 +1,23 @@+module Data.Functor.Join where++import Data.Bifunctor+import Data.Bifoldable+import Data.Bitraversable+import Data.Bicotraversable+import Data.Cotraversable+import Data.Functor.Classes+import Text.Read (Read (..))++newtype Join p a = Join { unJoin :: p a a }+instance Eq2 p => Eq1 (Join p) where liftEq eq (Join x) (Join y) = liftEq2 eq eq x y+instance Ord2 p => Ord1 (Join p) where liftCompare cmp (Join x) (Join y) = liftCompare2 cmp cmp x y+instance Read2 p => Read1 (Join p) where liftReadPrec rp rlp = Join <$> liftReadPrec2 rp rlp rp rlp+instance Show2 p => Show1 (Join p) where liftShowsPrec sp sl n = liftShowsPrec2 sp sl sp sl n . unJoin+instance (Eq2 p, Eq a) => Eq (Join p a) where (==) = eq1+instance (Ord2 p, Ord a) => Ord (Join p a) where compare = compare1+instance (Read2 p, Read a) => Read (Join p a) where readPrec = readPrec1+instance (Show2 p, Show a) => Show (Join p a) where showsPrec = showsPrec1+instance Bifunctor p => Functor (Join p) where fmap f = Join . bimap f f . unJoin+instance Bifoldable p => Foldable (Join p) where foldMap f = bifoldMap f f . unJoin+instance Bitraversable p => Traversable (Join p) where traverse f = fmap Join . bitraverse f f . unJoin+instance Bicotraversable p => Cotraversable (Join p) where cotraverse f = Join . bicotraverse f f . fmap unJoin

@@ -1,5 +1,5 @@ name:                hs-functors-version:             0.1.1.0+version:             0.1.2.0 synopsis:            Functors from products of Haskell and its dual to Haskell -- description:          license:             BSD3@@ -10,15 +10,24 @@ category:            Math build-type:          Simple cabal-version:       >=1.10+tested-with:         GHC ==8.0.2+                   , GHC ==8.2.2  library   exposed-modules:     Control.Comonad+                     , Control.Comonad.Cofree                      , Control.Comonad.Trans.Class+                     , Control.Monad.Free                      , Control.Monad.Morph                      , Control.Monad.Trans.Compose+                     , Data.Bicotraversable+                     , Data.Bifunctor.Biff                      , Data.Bifunctor.Braided+                     , Data.Bifunctor.Tannen                      , Data.Cotraversable+                     , Data.Fix                      , Data.Functor.Contravariant+                     , Data.Functor.Join                      , Data.Profunctor   -- other-modules:          -- other-extensions:    @@ -28,7 +37,9 @@   default-language:    Haskell2010   default-extensions:  LambdaCase                      , UnicodeSyntax+                     , TypeOperators                      , PolyKinds+                     , RankNTypes                      , StandaloneDeriving                      , GeneralizedNewtypeDeriving                      , DeriveFunctor, DeriveFoldable, DeriveTraversable