recursion-schemes-ext 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+184/−20 lines, 7 filesdep +composition-preludedep −compositionPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: composition-prelude

Dependencies removed: composition

API changes (from Hackage documentation)

Files

• README.md +3/−0
• bench/Bench.hs +3/−2
• recursion-schemes-ext.cabal +3/−2
• src/Data/Foldable/Functor/Examples.hs +89/−0
• src/Data/Foldable/Functor/Extensions.hs +45/−8
• stack.yaml +4/−2
• test/Spec.hs +37/−6

@@ -3,3 +3,6 @@ This adds several functions to [recursion-schemes](https://hackage.haskell.org/package/recursion-schemes-5.0.2), 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.

@@ -1,8 +1,9 @@ module Main where -import Criterion.Main+import           Criterion.Main+import           Data.Functor.Foldable.Examples () -main = do+main =     defaultMain [ bgroup "head"                       [ bench "fortune-teller" $ whnf head [1..] ]                 ]

@@ -1,5 +1,5 @@ name:                recursion-schemes-ext-version:             0.1.0.0+version:             0.1.0.1 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@@ -24,9 +24,10 @@ library   hs-source-dirs:      src   exposed-modules:     Data.Foldable.Functor.Extensions+                       Data.Foldable.Functor.Examples   build-depends:       base >= 4.7 && < 5                      , recursion-schemes-                     , composition+                     , composition-prelude   default-language:    Haskell2010   if flag(development)     ghc-options: -Werror

@@ -0,0 +1,89 @@+{-# 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'

@@ -7,25 +7,62 @@     ( dicata     , dendro     , micro+    , symplecto+    , chema     , cataM+    , SubHom (..)+    , CoSubHom (..)+    , Dummy (..)     ) where  import           Control.Arrow         ((&&&))+import           Control.Composition   ((-.*), (.*)) import           Control.Monad         ((<=<))-import           Data.Composition      ((.*))-import           Data.Functor.Foldable (Base, Corecursive, Recursive, cata,-                                        elgot, embed, project)+import           Data.Functor.Foldable (Base, Corecursive, Recursive, ana, cata,+                                        elgot, embed, hylo, project) --- | Class that yields F-algebra homomorphisms between mutually recursive types+-- | 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) --- FIXME codependent data types in test suite should be called "Ernie" and "Bert"+-- | Class that yields g-coalgebra homomorphisms between mutually recursive types.+class (Functor f, Functor g) => CoSubHom f g a b where -dendro :: (SubHom (Base t1) (Base t2) a b, Recursive t2) => (Base t1 a -> a) -> (Base t2 b -> b) -> t2 -> b-dendro = cata .* homo+    -- | Homomorphism of g-coalgebras paramterized by an f-coalgebra+    homoCo :: (a -> f a) -> (b -> g b) -> (b -> g b) --- | Catamorphism collapsing mutually data types simultaneously+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++-- | 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) 

@@ -1,8 +1,10 @@ resolver: lts-9.0 packages: - '.'-extra-deps: []+extra-deps:+    - composition-prelude-0.1.0.0+    - recursion-schemes-ext-0.1.0.0 flags:     recursion-schemes-ext:-        development: false+        development: true extra-package-dbs: []

@@ -1,8 +1,39 @@-import           Data.Foldable.Functor.Extensions-import           Test.Hspec+import           Data.Foldable.Functor.Examples (Bert (Add, Bert, Num),+                                                 Ernie (Ernie, Multiply),+                                                 collapseBertSyntaxTree,+                                                 collapseErnieSyntaxTree,+                                                 collapseErnieSyntaxTree')+import           Test.Hspec                     (describe, hspec, it, parallel,+                                                 shouldBe) +bertSum :: Bert+bertSum = Add (Num 2) (Num 3)++ernieMult :: Ernie+ernieMult = Multiply (Ernie bertSum) (Ernie (Num 3))++bertNothing :: Bert+bertNothing = Bert ernieMult++ernieComplex :: Ernie+ernieComplex = Ernie bertNothing++bertComplex :: Bert+bertComplex = Add (Num 3) (Bert ernieMult)++resultErnie :: Ernie+resultErnie = Ernie (Num 15)+ main :: IO ()-main = hspec $ do-    describe "head" $ do-        parallel $ it "parses a .mad string with modifiers" $ do-            head [1..] `shouldBe` 1+main = hspec $+    describe "dendro" $ do+        parallel $ it "collapses a simple syntax tree" $+            collapseBertSyntaxTree bertSum `shouldBe` Num 5+        parallel $ it "collapses both parts of a syntax tree" $+            collapseErnieSyntaxTree ernieMult `shouldBe` resultErnie+        parallel $ it "matches solution via catamorphism" $+            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