free-functors 0.4.1 → 0.5

raw patch · 4 files changed

+74/−27 lines, 4 filesdep +template-haskelldep ~algebraic-classesPVP ok

version bump matches the API change (PVP)

Dependencies added: template-haskell

Dependency ranges changed: algebraic-classes

API changes (from Hackage documentation)

Files

• examples/FreeNum.hs +2/−3
• examples/NonEmptyList.hs +6/−9
• free-functors.cabal +3/−2
• src/Data/Functor/Free.hs +63/−13

@@ -1,11 +1,10 @@-{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module FreeNum where  import Data.Functor.Free-import Data.Algebra  -deriveInstance [t| () => Num (Free Num a) |]+deriveInstances ''Num   x, y :: Free Num String

@@ -1,8 +1,7 @@-{-# LANGUAGE FlexibleInstances, TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module NonEmptyList where  import Data.Functor.Free-import Data.Algebra  import Control.Applicative import Control.Comonad@@ -11,14 +10,12 @@  import Data.Semigroup   --- This declaration creates a Functor that is also Applicative.+-- A free semigroup allows you to create singletons and append them.+-- So it is a non-empty list. type NonEmptyList = Free Semigroup --- This instance makes NonEmptyList a Monad.-deriveInstance [t| () => Semigroup (NonEmptyList a) |]---- This instance makes NonEmptyList Foldable and Traversable.-deriveInstance [t| Applicative f => Semigroup (LiftAFree Semigroup f a) |]+-- These instances make NonEmptyList a Semigroup and Foldable and Traversable.+deriveInstances ''Semigroup  -- The next two instances make NonEmptyList a Comonad. instance Semigroup (Identity a) where@@ -27,7 +24,7 @@ instance Semigroup (Compose NonEmptyList NonEmptyList a) where   Compose l <> Compose r = Compose $ ((<> extract r) <$> l) <> r -  +    fromList :: [a] -> NonEmptyList a fromList = foldr1 (<>) . map return

@@ -1,5 +1,5 @@ name:                free-functors-version:             0.4.1+version:             0.5 synopsis:            Provides free functors that are adjoint to functors that forget class constraints.  description:         A free functor is a left adjoint to a forgetful functor. It used to be the case                      that the only category that was easy to work with in Haskell was Hask itself, so@@ -45,7 +45,8 @@     transformers >= 0.2.0.0 && < 0.4,     comonad >= 3.0 && < 3.2,     void >= 0.4 && < 0.7,-    algebraic-classes >= 0.1 && < 0.4+    algebraic-classes >= 0.3.2 && < 0.4,+    template-haskell >= 2.8.0.0 && < 2.8.1  source-repository head   type:     git

@@ -10,6 +10,7 @@   , DeriveFunctor   , DeriveFoldable   , DeriveTraversable+  , TemplateHaskell   #-} ----------------------------------------------------------------------------- -- |@@ -27,24 +28,55 @@    import Control.Applicative import Control.Comonad+import Data.Function  import Data.Constraint hiding (Class) import Data.Constraint.Forall  import Data.Functor.Identity import Data.Functor.Compose-import Data.Foldable+import Data.Foldable (Foldable(..)) import Data.Traversable import Data.Void  import Data.Algebra+import Data.Algebra.TH+import Language.Haskell.TH.Syntax --- | The free functor for constraint @c@.+-- | The free functor for class @c@. +--+--   @Free c a@ is basically an expression tree with operations from class @c@ +--   and variables/placeholders of type @a@, created with `unit`.+--   Monadic bind allows you to replace each of these variables with another sub-expression. newtype Free c a = Free { runFree :: forall b. c b => (a -> b) -> b } +-- | Derive the instances for the class @c@ of @`Free` c a@ and @`LiftAFree` c f a@.+--+-- For example: +-- +-- @deriveInstances ''Num@+deriveInstances :: Name -> Q [Dec]+deriveInstances nm = concat <$> sequenceA+  [ deriveSignature nm+  , deriveInstanceWith_skipSignature freeHeader $ return []+  , deriveInstanceWith_skipSignature liftAFreeHeader $ return []+  ]+  where+    freeHeader = return $ ForallT [PlainTV a] [] +      (AppT c (AppT (AppT free c) (VarT a)))+    liftAFreeHeader = return $ ForallT [PlainTV f,PlainTV a] [ClassP ''Applicative [VarT f]] +      (AppT c (AppT (AppT (AppT liftAFree c) (VarT f)) (VarT a)))+    free = ConT ''Free+    liftAFree = ConT ''LiftAFree+    c = ConT nm+    a = mkName "a"+    f = mkName "f"+  +-- | `unit` allows you to create `Free c` values, together with the operations from the class @c@. unit :: a -> Free c a unit a = Free $ \k -> k a +-- | `rightAdjunct` is the destructor of `Free c` values. rightAdjunct :: c b => (a -> b) -> Free c a -> b rightAdjunct f g = runFree g f @@ -74,21 +106,43 @@ leftAdjunct :: (Free c a -> b) -> a -> b leftAdjunct f = f . unit +-- | @transform f as = as >>= f unit@+--+-- @transform f . transform g = transform (g . f)@+transform :: (forall r. c r => (b -> r) -> a -> r) -> Free c a -> Free c b+transform t (Free f) = Free (f . t)++-- | @unfold f = coproduct (unfold f) unit . f@+--+-- `inL` and `inR` are useful here. For example, the following creates the list @[1..10]@ as a @Free Monoid@:+--+-- @unfold (\b -> if b == 0 then mempty else `inL` (b - 1) \<> `inR` b) 10@+unfold :: (b -> Coproduct c b a) -> b -> Free c a+unfold f = fix $ \go -> transform (\k -> either (rightAdjunct k . go) k) . f++-- | @convert = rightAdjunct pure@+convert :: (c (f a), Applicative f) => Free c a -> f a+convert = rightAdjunct pure++-- | @convertClosed = rightAdjunct absurd@+convertClosed :: c r => Free c Void -> r+convertClosed = rightAdjunct absurd+ instance Functor (Free c) where-  fmap f (Free g) = Free (g . (. f))+  fmap f = transform (. f)  instance Applicative (Free c) where   pure = unit-  fs <*> as = Free $ \k -> runFree fs (\f -> runFree as (k . f))+  fs <*> as = transform (\k f -> rightAdjunct (k . f) as) fs -instance ForallF c (Free c) => Monad (Free c) where+instance Monad (Free c) where   return = unit-  (>>=) = flip rightAdjunctF+  as >>= f = transform (\k -> rightAdjunct k . f) as -instance (ForallF c Identity, ForallF c (Free c), ForallF c (Compose (Free c) (Free c)))+instance (ForallF c Identity, ForallF c (Compose (Free c) (Free c)))   => Comonad (Free c) where   extract = runIdentity . rightAdjunctF Identity-  extend g = fmap g . getCompose . rightAdjunctF (Compose . return . return)+  duplicate = getCompose . rightAdjunctF (Compose . unit . unit)  instance c ~ Class f => Algebra f (Free c a) where   algebra fa = Free $ \k -> evaluate (fmap (rightAdjunct k) fa)@@ -102,13 +156,9 @@   foldMap = foldMapDefault  instance ForallT c (LiftAFree c) => Traversable (Free c) where-  traverse f = getLiftAFree . rightAdjunctT (LiftAFree . fmap pure . f)+  traverse f = getLiftAFree . rightAdjunctT (LiftAFree . fmap unit . f) -convert :: (c (f a), Applicative f) => Free c a -> f a-convert = rightAdjunct pure -convertClosed :: c r => Free c Void -> r-convertClosed = rightAdjunct absurd  -- * Coproducts