recursion-schemes-ext 0.1.0.3 → 0.1.0.4

raw patch · 9 files changed

+315/−181 lines, 9 filesdep +deepseqdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: deepseq

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +76/−1
• bench/Bench.hs +25/−4
• recursion-schemes-ext.cabal +7/−6
• src/Data/Foldable/Functor/Examples.hs +0/−89
• src/Data/Foldable/Functor/Extensions.hs +0/−76
• src/Data/Functor/Foldable/Examples.hs +103/−0
• src/Data/Functor/Foldable/Extensions.hs +100/−0
• stack.yaml +1/−2
• test/Spec.hs +3/−3

@@ -5,4 +5,79 @@ including a `cataM`.  At the moment, you should be careful using functions from this package. While-APIs will likely be stable, they may occasionally be wrong.+APIs will likely be stable, they may have poor performance.++## Pitch++Let's say you want to collapse a syntax tree. Suppose further that it's a+relatively involved syntax tree, and you have some data types that encapsulate+others. Here's a simple-minded example, where we collapse using traditional+recursion schemes:++```haskell+-- | We call our co-dependent data types 'Ernie' and 'Bert'. They represent mutually recursive+data Bert = Bert Ernie+          | Num Integer+          | String String+          | Add Bert Bert++data Ernie = Ernie Bert+           | Multiply Ernie Ernie+           | List [Ernie]++makeBaseFunctor ''Ernie+makeBaseFunctor ''Bert++collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie+collapseErnieSyntaxTree = cata algebra+    where algebra (ErnieF e)                                  = Ernie $ collapseBertSyntaxTree' e+          algebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j+          algebra x                                           = embed x++collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert+collapseBertSyntaxTree = cata algebra+    where algebra (BertF e)              = Bert $ collapseErnieSyntaxTree' e+          algebra (AddF (Num i) (Num j)) = Num $ i + j+          algebra x                      = embed x+```++Contrast this to the solution using a dendromorphism, viz.++```haskell+-- | We call our co-dependent data types 'Ernie' and 'Bert'. They represent mutually recursive+data Bert = Bert Ernie+          | Num Integer+          | String String+          | Add Bert Bert++data Ernie = Ernie Bert+           | Multiply Ernie Ernie+           | List [Ernie]++makeBaseFunctor ''Ernie+makeBaseFunctor ''Bert++entangleFunctors [(''Ernie, ''Bert), (''Bert, ''Ernie)]++bertAlgebra :: BertF Bert -> Bert+bertAlgebra (AddF (Num i) (Num j)) = Num $ i + j+bertAlgebra x                      = embed x++ernieAlgebra :: ErnieF Ernie -> Ernie+ernieAlgebra (ErnieF (Bert e))                           = e+ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j+ernieAlgebra x                                           = embed x++collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie+collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra++collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert+collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra+```++## Anti-Pitch++Using dendromorphisms rather than catamorphisms is slow. As such, for the above+example, you'd probably pick the catamorphism most of the time. In fact,+dendromorphisms are really only useful on sufficiently complicated projects+where writing correct code would be difficult or inconvenient without them.

@@ -1,9 +1,30 @@ module Main where -import           Criterion.Main-import           Data.Functor.Foldable.Examples ()+import           Criterion.Main                 (bench, bgroup, defaultMain, nf)+import           Data.Functor.Foldable.Examples (Bert (Add, Bert, Num),+                                                 Ernie (Ernie, Multiply),+                                                 collapseBertSyntaxTree,+                                                 collapseBertSyntaxTree') +bert :: Bert+bert = Add (Num 2) (Num 3)++ernie :: Ernie+ernie = Multiply (Ernie bert) (Ernie (Num 3))++bertNothing :: Bert+bertNothing = Bert ernie++ernieNested :: Ernie+ernieNested = Ernie bertNothing++bertComplex :: Bert+bertComplex = Add (Bert ernieNested) (Bert ernie)++main :: IO () main =-    defaultMain [ bgroup "head"-                      [ bench "fortune-teller" $ whnf head [1..] ]+    defaultMain [ bgroup "collapseErnieSyntaxTree"+                      [ bench "dendromorphism" $ nf collapseBertSyntaxTree  bertComplex+                      , bench "catamorphism"   $ nf collapseBertSyntaxTree' bertComplex+                      ]                 ]

@@ -1,5 +1,5 @@ name:                recursion-schemes-ext-version:             0.1.0.3+version:             0.1.0.4 synopsis:            Amateur addenda to recursion-schemes description:         This package provides some exotic recursion schemes that I miss when I leave Idris. homepage:            https://hub.darcs.net/vmchale/recursion-schemes-ext#readme@@ -23,17 +23,18 @@  library   hs-source-dirs:      src-  exposed-modules:     Data.Foldable.Functor.Extensions-                       Data.Foldable.Functor.Examples-  build-depends:       base < 5+  exposed-modules:     Data.Functor.Foldable.Extensions+                       Data.Functor.Foldable.Examples+  build-depends:       base > 4.8 && < 5                      , recursion-schemes >= 5.0                      , composition-prelude+                     , deepseq   default-language:    Haskell2010   if flag(development)     ghc-options: -Werror   ghc-options:         -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists -test-suite recursion-schemes-ext-test+test-suite recursion-schemes-test   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs@@ -46,7 +47,7 @@     ghc-options: -Werror   ghc-options:         -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-import-lists -benchmark recursion-schemes-ext-bench+benchmark recursion-schemes-bench   type:                exitcode-stdio-1.0   hs-source-dirs:      bench   main-is:             Bench.hs

@@ -1,89 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes   #-}-{-# LANGUAGE DeriveFoldable        #-}-{-# LANGUAGE DeriveFunctor         #-}-{-# LANGUAGE DeriveTraversable     #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell       #-}-{-# LANGUAGE TypeFamilies          #-}--module Data.Foldable.Functor.Examples ( Bert (..)-                                      , Ernie (..)-                                      , BertF (..)-                                      , ErnieF (..)-                                      , collapseErnieSyntaxTree-                                      , collapseErnieSyntaxTree'-                                      , collapseBertSyntaxTree-                                      , collapseBertSyntaxTree'-                                      ) where--import           Data.Foldable.Functor.Extensions (Dummy (dummy), SubHom (homo),-                                                   dendro)-import           Data.Functor.Foldable            (Recursive, cata, embed)-import           Data.Functor.Foldable.TH         (makeBaseFunctor)---- | We call our co-dependent data types 'Ernie' and 'Bert'. They represent mutually recursive-data Bert = Bert Ernie-          | Num Integer-          | String String-          | Add Bert Bert-           deriving (Show, Eq)--data Ernie = Ernie Bert-           | Multiply Ernie Ernie-           | List [Ernie]-           deriving (Show, Eq)--makeBaseFunctor ''Bert-makeBaseFunctor ''Ernie--instance Dummy Bert where-    dummy = Num 3--instance Dummy Ernie where-    dummy = Ernie dummy--instance SubHom ErnieF BertF Ernie Bert where--    homo ea alberta (BertF e) = Bert $ dendro (dummy :: Bert) alberta ea e-    homo _ f b                = f b--instance SubHom BertF ErnieF Bert Ernie where--    homo alberta ea (ErnieF b) = Ernie $ dendro (dummy :: Ernie) ea alberta b-    homo _ f e                 = f e--bertAlgebra :: BertF Bert -> Bert-bertAlgebra (AddF (Num i) (Num j)) = Num $ i + j-bertAlgebra x                      = embed x---- Problem: precomposing with a homomorphism isn't enough?-ernieAlgebra :: ErnieF Ernie -> Ernie-ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j-ernieAlgebra x                                           = embed x---- | Dendromorphism collapsing the tree-collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie-collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra---- | We get two dendromorphisms for the price of one!-collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert-collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra--bertAlgebra' :: BertF Bert -> Bert-bertAlgebra' (BertF e)              = Bert $ collapseErnieSyntaxTree' e-bertAlgebra' (AddF (Num i) (Num j)) = Num $ i + j-bertAlgebra' x                      = embed x--ernieAlgebra' :: ErnieF Ernie -> Ernie-ernieAlgebra' (ErnieF e)                                  = Ernie $ collapseBertSyntaxTree' e-ernieAlgebra' (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j-ernieAlgebra' x                                           = embed x---- | Catamorphism, which collapses the tree, but not very well.-collapseErnieSyntaxTree' :: (Recursive Ernie) => Ernie -> Ernie-collapseErnieSyntaxTree' = cata ernieAlgebra'---- | Another catamorphism that is stupid and lame.-collapseBertSyntaxTree' :: (Recursive Bert) => Bert -> Bert-collapseBertSyntaxTree' = cata bertAlgebra'

@@ -1,76 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes   #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}--module Data.Foldable.Functor.Extensions-    ( dicata-    , dendro-    , micro-    , symplecto-    , chema-    , cataM-    , SubHom (..)-    , CoSubHom (..)-    , Dummy (..)-    ) where--import           Control.Arrow         ((&&&))-import           Control.Composition   ((-.*), (.*))-import           Control.Monad         ((<=<))-import           Data.Functor.Foldable (Base, Corecursive, Recursive, ana, cata,-                                        elgot, embed, hylo, project)---- | Class that yields g-algebra homomorphisms between mutually recursive types.-class (Functor f, Functor g) => SubHom f g a b where--    -- | Homomorphism of g-algebras parametrized by an f-algebra-    homo :: (f a -> a) -> (g b -> b) -> (g b -> b)---- | Class that yields g-coalgebra homomorphisms between mutually recursive types.-class (Functor f, Functor g) => CoSubHom f g a b where--    -- | Homomorphism of g-coalgebras paramterized by an f-coalgebra-    homoCo :: (a -> f a) -> (b -> g b) -> (b -> g b)--class Dummy t where-    dummy :: t---- manjari or margaritari?---- | Entangle two hylomorphisms. Not the same thing as a symplectomorphism from geometry.-symplecto :: (SubHom g f b b, CoSubHom g f a a)-    => (g b -> b) -- ^ A g-algebra-    -> (a -> g a) -- ^ A g-coalgebra-    -> (f b -> b) -- ^ An f-algebra-    -> (a -> f a) -- ^ An f-coalgebra-    -> a -> b-symplecto = homoCo -.* (flip . ((.) .* hylo .* homo)) -- FIXME what the fuck did I do---- Entangle two anamorphisms-chema :: (CoSubHom (Base t) (Base t') a b, Corecursive t')-    => (a -> Base t a) -- A (Base t)-coalgebra-    -> (b -> Base t' b) -- A (Base t')-coalgebra-    -> b -> t'-chema = ana .* homoCo---- FIXME maybe run the catamorphism on the inner bit?---- | A dendromorphism allows us to entangle two catamorphisms-dendro :: (SubHom (Base t) (Base t') a b, Recursive t')-    => t -- ^ dummy type-    -> (Base t a -> a) -- ^ A (Base t)-algebra-    -> (Base t' b -> b) -- ^ A (Base t')-algebra-    -> t' -> b-dendro _ = cata .* homo---- | Catamorphism collapsing along two data types simultaneously. Basically a fancy zygomorphism.-dicata :: (Recursive a) => (Base a (b, a) -> b) -> (Base a (b, a) -> a) -> a -> b-dicata f g = fst . cata (f &&& g)---- | A micromorphism is an Elgot algebra specialized to unfolding.-micro :: (Corecursive a) => (b -> Either a (Base a b)) -> b -> a-micro = elgot embed--cataM :: (Recursive t, Traversable (Base t), Monad m) => (Base t a -> m a) -> (t -> m a)-cataM phi = g where g = phi <=< (mapM g . project)

@@ -0,0 +1,103 @@+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE DeriveAnyClass        #-}+{-# LANGUAGE DeriveFoldable        #-}+{-# LANGUAGE DeriveFunctor         #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE DeriveTraversable     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeFamilies          #-}++module Data.Functor.Foldable.Examples ( Bert (..)+                                      , Ernie (..)+                                      , BertF (..)+                                      , ErnieF (..)+                                      , collapseErnieSyntaxTree+                                      , collapseErnieSyntaxTree'+                                      , collapseBertSyntaxTree+                                      , collapseBertSyntaxTree'+                                      ) where++import           Control.DeepSeq                  (NFData)+import           Data.Functor.Foldable            (Recursive, cata, embed)+import           Data.Functor.Foldable.Extensions (Dummy (dummy), SubHom (homo),+                                                   SubType (switch), dendro)+import           Data.Functor.Foldable.TH         (makeBaseFunctor)+import           GHC.Generics                     (Generic)++-- | We call our co-dependent data types 'Ernie' and 'Bert'. They represent mutually recursive+data Bert = Bert Ernie+          | Num Integer+          | String String+          | Add Bert Bert+           deriving (Show, Eq, Generic, NFData)++data Ernie = Ernie Bert+           | Multiply Ernie Ernie+           | List [Ernie]+           deriving (Show, Eq, Generic, NFData)++-- want: entangleBaseFunctors function to do this automatically!++makeBaseFunctor ''Ernie+makeBaseFunctor ''Bert++-- TODO default/dummy? Also infer dummy from applicative + dummy underlying type++instance Dummy Bert where+    dummy = Num 3++instance Dummy Ernie where+    dummy = Ernie dummy++instance SubHom ErnieF BertF Ernie Bert where++    homo ea alberta (BertF e) = Bert $ dendro (dummy :: Bert) alberta ea e+    homo _ f b                = f b++instance SubType Bert where++    switch (Bert (Ernie b)) = b+    switch x                = x++instance SubHom BertF ErnieF Bert Ernie where++    homo alberta ea (ErnieF b) = Ernie $ dendro (dummy :: Ernie) ea alberta b+    homo _ f e                 = f e++instance SubType Ernie where++    switch (Ernie (Bert e)) = e+    switch x                = x++bertAlgebra :: BertF Bert -> Bert+bertAlgebra (AddF (Num i) (Num j)) = Num $ i + j+bertAlgebra x                      = embed x++ernieAlgebra :: ErnieF Ernie -> Ernie+ernieAlgebra (ErnieF (Bert e))                           = e+ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j+ernieAlgebra x                                           = embed x++-- | Dendromorphism collapsing the tree+collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie+collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra++-- | We get two dendromorphisms for the price of one!+collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert+collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra++-- | Catamorphism, which collapses the tree, but not very well.+collapseErnieSyntaxTree' :: (Recursive Ernie) => Ernie -> Ernie+collapseErnieSyntaxTree' = cata algebra+    where algebra (ErnieF e)                                  = Ernie $ collapseBertSyntaxTree' e+          algebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j+          algebra x                                           = embed x++-- | Another catamorphism that is stupid and lame.+collapseBertSyntaxTree' :: (Recursive Bert) => Bert -> Bert+collapseBertSyntaxTree' = cata algebra+    where algebra (BertF e)              = Bert $ collapseErnieSyntaxTree' e+          algebra (AddF (Num i) (Num j)) = Num $ i + j+          algebra x                      = embed x

@@ -0,0 +1,100 @@+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Functor.Foldable.Extensions+    ( dicata+    , dendro+    , dendroTri+    , micro+    , symplecto+    , chema+    , cataM+    , SubHom (..)+    , SubType (..)+    , CoSubHom (..)+    , Dummy (..)+    ) where++import           Control.Arrow         ((&&&))+import           Control.Composition   (fix, (-.*), (.*), (.**))+import           Control.Monad         ((<=<))+import           Data.Functor.Foldable (Base, Corecursive, Recursive, cata,+                                        elgot, embed, hylo, project)++-- | Class that yields g-algebra homomorphisms between mutually recursive types.+class (Functor f, Functor g) => SubHom f g a b where++    -- | Homomorphism of g-algebras parametrized by an f-algebra+    homo :: (f a -> a) -> (g b -> b) -> (g b -> b)++class SubType b where++    -- | Resolve nested functions.+    switch :: b -> b++-- | Class that yields g-coalgebra homomorphisms between mutually recursive types.+class (Functor f, Functor g) => CoSubHom f g a b where++    -- | Homomorphism of g-coalgebras paramterized by an f-coalgebra+    homoCo :: (a -> f a) -> (b -> g b) -> (b -> g b)++    -- | Resolve nested functions+    coswitch :: a -> a++class Dummy t where+    dummy :: t++-- Delta functor: just the diagonal :)++--margaritari ::++-- | Entangle two hylomorphisms. Not the same thing as a symplectomorphism from geometry.+symplecto :: (SubHom g f b b, CoSubHom g f a a)+    => (g b -> b) -- ^ A g-algebra+    -> (a -> g a) -- ^ A g-coalgebra+    -> (f b -> b) -- ^ An f-algebra+    -> (a -> f a) -- ^ An f-coalgebra+    -> a -> b+symplecto = homoCo -.* (flip . ((.) .* hylo .* homo)) -- FIXME what the fuck did I do here++-- Entangle two anamorphisms.+chema :: (CoSubHom (Base t) (Base t') a b, SubType b, Corecursive t')+    => (a -> Base t a) -- A (Base t)-coalgebra+    -> (b -> Base t' b) -- A (Base t')-coalgebra+    -> b -> t'+chema = pseudoana .* homoCo+    where pseudoana g = a where a = embed . fmap a . g . switch++-- FIXME maybe run the catamorphism on the inner bit?++-- | A dendromorphism allows us to entangle two catamorphisms+dendro :: (SubHom (Base t) (Base t') a b, SubType b, Recursive t')+    => t -- ^ dummy type+    -> (Base t a -> a) -- ^ A (Base t)-algebra+    -> (Base t' b -> b) -- ^ A (Base t')-algebra+    -> t' -> b+dendro = const ((pseudocata .* homo))+    where pseudocata f = c where c = switch . f . fmap c . project++-- | Entangle three base functors.+dendroTri :: (SubHom (Base t) (Base t') a b, SubType b, Recursive t', SubHom (Base t'') (Base t) c a, SubType a, Recursive t)+    => t -- ^ dummy type+    -> t'' -- ^ another dummy type+    -> (Base t'' c -> c) -- ^ A (Base t'')-algebra+    -> (Base t a -> a) -- A (Base t)-algebra+    -> (Base t' b -> b) -- A (Base t')-algebra+    -> t' -> b+dendroTri = const . (switch .** homo -.* ((.) . dendro))++-- | Catamorphism collapsing along two data types simultaneously. Basically a fancy zygomorphism.+dicata :: (Recursive a) => (Base a (b, a) -> b) -> (Base a (b, a) -> a) -> a -> b+dicata = fst .** (cata .* (&&&))++-- | A micromorphism is an Elgot algebra specialized to unfolding.+micro :: (Corecursive a) => (b -> Either a (Base a b)) -> b -> a+micro = elgot embed++cataM :: (Recursive t, Traversable (Base t), Monad m) => (Base t a -> m a) -> (t -> m a)+cataM phi = fix ((phi <=<) . (project -.* mapM))

@@ -2,8 +2,7 @@ packages: - '.' extra-deps:-    - composition-prelude-0.1.0.1-    - recursion-schemes-ext-0.1.0.0+    - composition-prelude-0.1.0.4 flags:     recursion-schemes-ext:         development: true

@@ -1,4 +1,4 @@-import           Data.Foldable.Functor.Examples (Bert (Add, Bert, Num),+import           Data.Functor.Foldable.Examples (Bert (Add, Bert, Num),                                                  Ernie (Ernie, Multiply),                                                  collapseBertSyntaxTree,                                                  collapseErnieSyntaxTree,@@ -35,5 +35,5 @@             collapseErnieSyntaxTree' ernieMult `shouldBe` collapseErnieSyntaxTree ernieMult         parallel $ it "collapses complex syntax trees" $             collapseBertSyntaxTree bertComplex `shouldBe` Num 18-        parallel $ it "should work would when doubly wrapped" $-            collapseErnieSyntaxTree ernieComplex `shouldBe` resultErnie+        parallel $ it "should work would when triply wrapped" $+            collapseErnieSyntaxTree (Ernie (Bert ernieComplex)) `shouldBe` resultErnie