catamorphism 0.6.1.1 → 0.7.0.0

raw patch · 3 files changed

+30/−22 lines, 3 filesdep +QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck

API changes (from Hackage documentation)

Files

• catamorphism.cabal +2/−2
• src/Data/Morphism/Cata.hs +10/−3
• test/Data/Morphism/CataSpec.hs +18/−17

@@ -1,5 +1,5 @@ name:                catamorphism-version:             0.6.1.1+version:             0.7.0.0 synopsis:            Exposes a Template Haskell function for generating catamorphisms. description:   This module exposes a 'makeCata' function which can create catamorphisms for@@ -71,6 +71,6 @@   main-is:             Tests.hs   hs-source-dirs:      test   ghc-options:         -Wall-  build-depends:       base, catamorphism, hspec+  build-depends:       base, catamorphism, hspec, QuickCheck   other-modules:       Data.Morphism.CataSpec   default-language:    Haskell2010

@@ -62,6 +62,7 @@ > numVars = cataExpr (const 1) (const 0) (+) -} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} module Data.Morphism.Cata     ( CataOptions(..)@@ -148,7 +149,10 @@     argTypes = map fixupArgType (conArgTypes c)      fixupArgType t = case typeName t of-                        Just n  -> if n == inputT then VarT resultT else t+                        Just n+                            | n == inputT   -> VarT resultT+                            | n == listName -> AppT ListT (VarT resultT)+                            | otherwise     -> t                         Nothing -> t  -- |The 'makeCata' function creates a catamorphism for the given type.@@ -197,8 +201,11 @@             let patNames = map (\(VarP n) -> n) conPats              let translateArg t arg = case typeName t of-                    Just n -> if n == ty then foldl AppE (VarE funName) (map VarE (conArgNames ++ [arg])) else VarE arg-                    Nothing -> VarE arg+                    Just n+                        | n == ty       -> foldl AppE (VarE funName) (map VarE (conArgNames ++ [arg]))+                        | n == listName -> foldl1 AppE [VarE 'fmap, AppE (VarE funName) (VarE cn), VarE arg]+                        | otherwise     -> VarE arg+                    Nothing             -> VarE arg              let argsWithTypes = zipWith translateArg (conArgTypes c) patNames             let bodyE = foldl AppE (VarE cn) argsWithTypes

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}  -- GHC 7.10 seems to require KindSignatures for the polymorph folds defined -- below.@@ -10,6 +11,7 @@ module Data.Morphism.CataSpec (main, spec) where  import Test.Hspec+import Test.QuickCheck import Data.Morphism.Cata  import Data.Bool (bool)@@ -21,6 +23,7 @@ data PolymorphSum a = PolymorphSum a data PolymorphProduct a b = PolymorphProduct a b data RegularRecursive a = Cons a (RegularRecursive a) | Empty+data RoseTree a = Node a [RoseTree a]  $(makeCata defaultOptions ''Unit) $(makeCata defaultOptions ''Binary)@@ -28,6 +31,7 @@ $(makeCata defaultOptions ''PolymorphProduct) $(makeCata defaultOptions ''RegularRecursive) $(makeCata defaultOptions { cataName = "binaryFold" } ''Binary)+$(makeCata defaultOptions ''RoseTree)  $(makeCata defaultOptions { cataName = "bool'" } ''Bool) $(makeCata defaultOptions { cataName = "maybe'" } ''Maybe)@@ -65,31 +69,28 @@       length' (Cons () (Cons () (Cons () Empty))) `shouldBe` 3       length' (Cons 'a' (Cons 'b' Empty)) `shouldBe` 2 +    it "handles rose trees" $ do+      let treeSum = roseTree (\x xs -> sum (x:xs)) :: RoseTree Int -> Int+      treeSum (Node 3 []) `shouldBe` 3+      treeSum (Node 0 [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 [], Node 6 []], Node 7 [Node 8 [], Node 9 []]]) `shouldBe` 45+   describe "custom options" $     it "allows customizing the function name" $ do       binaryFold 'z' 'o' Zero `shouldBe` 'z'       binaryFold 'z' 'o' One `shouldBe` 'o'    describe "equivalence" $ do-    let checkBinaryFn f g a b x = f a b x `shouldBe` g a b x+    let checkBinaryEquiv f g a b = property (\x -> f a b x == g a b x) -    it "can be used to define bool" $ do-      let check = checkBinaryFn bool bool' "false" "true"-      check False-      check True+    it "can be used to define bool" $+      checkBinaryEquiv bool bool' "false" "true" -    it "can be used to define maybe" $ do-      let check = checkBinaryFn maybe maybe' "<empty>" (++ "!!!")-      check Nothing-      check (Just "Hello")+    it "can be used to define maybe" $+      checkBinaryEquiv maybe maybe' "<empty>" (++ "!!!") -    it "can be used to define either" $ do-      let check = checkBinaryFn either either' show (++ "!!!")-      check (Left True)-      check (Right "Either")+    it "can be used to define either" $+      checkBinaryEquiv either either' (show :: Bool -> String) (++ "!!!") -    it "can be used to define foldr" $ do+    it "can be used to define foldr" $       -- Well, we can get 'foldr', but flipped.-      let check = checkBinaryFn (flip foldr) foldr' (0 :: Int) (\_ acc -> acc + 1)-      check []-      check "Frobnicate"+      checkBinaryEquiv foldr (flip foldr') (\(_ :: Int) (acc :: Int) -> acc + 1) 0