├── .gitignore ├── .hlint.yaml ├── .travis.yml ├── LICENSE ├── README.md ├── Setup.hs ├── catamorphism.cabal ├── src └── Data │ └── Morphism │ └── Cata.hs └── test ├── Data └── Morphism │ └── CataSpec.hs └── Tests.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virtualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | cabal.config 12 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | # Ignore this warning for now since I'm not sure whether I could 2 | # safely replace a newtype with data in a future release in case 3 | # I decide that I want to add more data constructors. 4 | - ignore: {name: "Use newtype instead of data"} 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | ghc: 3 | - "8.4.1" 4 | - "8.2" 5 | - "8.0" 6 | - "7.10" 7 | - "7.8" 8 | 9 | before_install: 10 | - cabal check 11 | - wget https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh -O - --quiet | sh -s . 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Frerich Raabe 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Frerich Raabe nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | catamorphisms 2 | ============= 3 | 4 | [![Build Status](https://travis-ci.org/frerich/catamorphism.svg?branch=master)](https://travis-ci.org/frerich/catamorphism) 5 | 6 | This project builds an Haskell module `Data.Morphism.Cata` which exports a 7 | `makeCata` function which can be used to generate 8 | [catamorphisms](http://www.haskell.org/haskellwiki/Catamorphisms) for Haskell 9 | types. The base package features a couple of standard catamorphisms such as 10 | [bool](http://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Bool.html#v:bool), 11 | [maybe](http://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Maybe.html#v:maybe), 12 | [either](http://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Either.html#v:either), 13 | or 14 | [foldr](http://hackage.haskell.org/package/base-4.8.0.0/docs/Prelude.html#v:foldr), 15 | all of which could be generated by 'makeCata'. However, catamorphisms are mostly 16 | useful for custom recursive data structures. For instance, given a simple type 17 | for modelling expressions involving numbers, variables and sums as in 18 | 19 | ``` haskell 20 | {-# LANGUAGE TemplateHaskell #-} 21 | 22 | import Data.Morphism.Cata 23 | import Data.Maybe (fromJust) 24 | 25 | data Expr a = Number a 26 | | Variable Char 27 | | Sum (Expr a) (Expr a) 28 | ``` 29 | 30 | You can use the following `makeCata` invocation to generate a function for folding `Expr` 31 | values - the function will be called `cataExpr`: 32 | 33 | ``` haskell 34 | {- This 'makeCata' invocation defines a function 35 | 36 | cataExpr :: (a -> b) -- Number constructor 37 | -> (Char -> b) -- Variable constructor 38 | -> (b -> b -> b) -- Sum constructor 39 | -> Expr a 40 | -> b 41 | -} 42 | $(makeCata defaultOptions { cataName = "cataExpr" } ''Expr) 43 | ``` 44 | 45 | This catamorphism can be used to define a whole bunch of other useful functions such as 46 | 47 | ``` haskell 48 | -- Evaluate an Expr, given some variable bindings 49 | eval :: Num a => [(Char, a)] -> Expr a -> a 50 | eval vars = cataExpr id (fromJust . (`lookup` vars)) (+) 51 | 52 | -- Pretty-prints an Expr 53 | pprint :: Show a => Expr a -> String 54 | pprint = cataExpr show show (\a b -> a ++ " + " ++ b) 55 | 56 | -- Counts the number of variables used in an expr 57 | numVars :: Expr a -> Int 58 | numVars = cataExpr (const 1) (const 0) (+) 59 | ``` 60 | 61 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /catamorphism.cabal: -------------------------------------------------------------------------------- 1 | name: catamorphism 2 | version: 0.7.0.0 3 | synopsis: Exposes a Template Haskell function for generating catamorphisms. 4 | description: 5 | This module exposes a 'makeCata' function which can create catamorphisms for 6 | arbitrary Haskell types. Catamorphisms are functions which deconstruct some 7 | value by replacing each data constructor with a custom function yielding a 8 | new value. See for a more 9 | in-depth discussion of catamorphisms in Haskell. 10 | . 11 | The Haskell base package already comes with a couple of standard 12 | catamorphisms, such as 'maybe' (for 'Maybe' values). The 'maybe' function 13 | could have been generated using 'makeCata' as follows: 14 | . 15 | > -- Defines 'maybe :: b -> (a -> b) -> Maybe a -> b' 16 | > $(makeCata defaultOptions ''Maybe) 17 | . 18 | However, catamorphisms are especially useful for recursive data structures. 19 | Consider the following simple example which defines a basic data type for 20 | modelling sums of numbers, supporting variables: 21 | . 22 | > import Data.Morphism.Cata 23 | > import Data.Maybe (fromJust) 24 | > 25 | > data Expr a = Number a 26 | > | Variable Char 27 | > | Sum (Expr a) (Expr a) 28 | > 29 | > -- Defines 'expr :: (a -> b) -> (Char -> b) -> (b -> b -> b) -> Expr a -> b' 30 | > $(makeCata defaultOptions ''Expr) 31 | . 32 | The 'makeCata' invocation defines a 'expr' function which works like a fold on 33 | 'Expr' values; it can be used to implement various useful other functions: 34 | . 35 | > -- Evaluate an Expr, given some variable bindings 36 | > eval :: Num a => [(Char, a)] -> Expr a -> a 37 | > eval vars = expr id (fromJust . (`lookup` vars)) (+) 38 | > 39 | > -- Pretty-prints an Expr 40 | > pprint :: Show a => Expr a -> String 41 | > pprint = expr show show (\a b -> a ++ " + " ++ b) 42 | > 43 | > -- Counts the number of variables used in an expr 44 | > numVars :: Expr a -> Int 45 | > numVars = expr (const 1) (const 0) (+) 46 | homepage: https://github.com/frerich/catamorphism 47 | license: BSD3 48 | license-file: LICENSE 49 | author: Frerich Raabe 50 | maintainer: frerich.raabe@gmail.com 51 | bug-reports: https://github.com/frerich/catamorphism/issues 52 | copyright: Copyright (c) 2014, 2015, 2016, 2017, 2018 Frerich Raabe 53 | category: Development 54 | build-type: Simple 55 | cabal-version: >=1.10 56 | stability: experimental 57 | 58 | source-repository head 59 | type: git 60 | location: https://github.com/frerich/catamorphism 61 | 62 | library 63 | exposed-modules: Data.Morphism.Cata 64 | build-depends: base >=4.6 && <4.12, template-haskell >=2.8 && <2.14 65 | hs-source-dirs: src 66 | default-language: Haskell2010 67 | ghc-options: -Wall 68 | 69 | test-suite spec 70 | type: exitcode-stdio-1.0 71 | main-is: Tests.hs 72 | hs-source-dirs: test 73 | ghc-options: -Wall 74 | build-depends: base, catamorphism, hspec, QuickCheck 75 | other-modules: Data.Morphism.CataSpec 76 | default-language: Haskell2010 77 | -------------------------------------------------------------------------------- /src/Data/Morphism/Cata.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module: Data.Morphism.Cata 3 | Copyright: (c) 2014 Frerich Raabe 4 | License: BSD3 5 | Maintainer: frerich.raabe@gmail.com 6 | Stability: experimental 7 | 8 | This module exposes a 'makeCata' function which can create catamorphisms for 9 | arbitrary Haskell types. Catamorphisms are functions which deconstruct some 10 | value by replacing each data constructor with a custom function yielding a new 11 | value. See for a more 12 | in-depth discussion of catamorphisms in Haskell. 13 | 14 | The Haskell base package already comes with a couple of standard catamorphisms 15 | such as 'bool' (for Bool values), 'maybe' (for Maybe values) values, 'either' 16 | for (Either values) values and 'foldr' (for lists). These catamorphisms could 17 | have been generated using 'makeCata' as follows: 18 | 19 | > -- Defines 'bool :: a -> a -> Bool -> a' 20 | > $(makeCata defaultOptions ''Bool) 21 | > 22 | > -- Defines 'maybe :: b -> (a -> b) -> Maybe a -> b' 23 | > $(makeCata defaultOptions ''Maybe) 24 | > 25 | > -- Defines 'either :: (a -> c) -> (b -> c) -> Either a b -> c' 26 | > $(makeCata defaultOptions ''Either) 27 | > 28 | > -- Defines 'fold :: b -> (a -> b -> b) -> [a] -> b', i.e. 'flip foldr'. Note 29 | > -- that a custom catamorphism name has to be specified since '[]' is not a 30 | > -- valid function name. 31 | > $(makeCata defaultOptions { cataName = "fold" } ''[]) 32 | 33 | However, catamorphisms are especially useful for recursive data structures. Consider 34 | the following simple example which defines a basic data type for modelling sums 35 | of numbers, supporting variables: 36 | 37 | > {-# LANGUAGE TemplateHaskell #-} 38 | > 39 | > import Data.Morphism.Cata 40 | > import Data.Maybe (fromJust) 41 | > 42 | > data Expr a = Number a 43 | > | Variable Char 44 | > | Sum (Expr a) (Expr a) 45 | > 46 | > -- Defines 'cataExpr :: (a -> b) -> (Char -> b) -> (b -> b -> b) -> Expr a -> b' 47 | > $(makeCata defaultOptions { cataName = "cataExpr" } ''Expr) 48 | 49 | The 'makeCata' invocation defines a 'cataExpr' function which works like a fold on 50 | 'Expr' values; it can be used to implement various useful other functions: 51 | 52 | > -- Evaluate an Expr, given some variable bindings 53 | > eval :: Num a => [(Char, a)] -> Expr a -> a 54 | > eval vars = cataExpr id (fromJust . (`lookup` vars)) (+) 55 | > 56 | > -- Pretty-prints an Expr 57 | > pprint :: Show a => Expr a -> String 58 | > pprint = cataExpr show show (\a b -> a ++ " + " ++ b) 59 | > 60 | > -- Counts the number of variables used in an expr 61 | > numVars :: Expr a -> Int 62 | > numVars = cataExpr (const 1) (const 0) (+) 63 | -} 64 | 65 | {-# LANGUAGE TemplateHaskell #-} 66 | {-# LANGUAGE CPP #-} 67 | module Data.Morphism.Cata 68 | ( CataOptions(..) 69 | , defaultOptions 70 | , makeCata 71 | ) 72 | where 73 | 74 | import Control.Monad (forM, replicateM) 75 | 76 | import Data.Char (toLower) 77 | -- The prelude exports (<$>) in base 4.8.0 and later, so don't include 78 | -- Data.Functor to avoid compiler warnings about unneeded imports. 79 | #if MIN_VERSION_base(4,8,0) 80 | #else 81 | import Data.Functor ((<$>)) 82 | #endif 83 | 84 | import Language.Haskell.TH 85 | import Language.Haskell.TH.Syntax (mkNameG, NameSpace(TcClsName)) 86 | 87 | {-| 88 | Values of the 'CataOptions' type can be passed to 'makeCata' in order to 89 | customize the generated catamorphism. At this point, only the name of the 90 | function can be changed. 91 | -} 92 | data CataOptions = CataOptions { 93 | {-| 94 | The desired name for the catamorphism. An empty string will make 95 | 'makeCata' derive the catamorphism name from the type by just taking 96 | the type name and making the first letter lower-case. 97 | -} 98 | cataName :: String 99 | } 100 | 101 | {-| 102 | The default catamorphism generation options; the catamorphism will be named 103 | after the type, e.g. 104 | 105 | > $(makeCata defaultOptions ''Bool) 106 | 107 | defines a function 'bool'. 108 | -} 109 | defaultOptions :: CataOptions 110 | defaultOptions = CataOptions "" 111 | 112 | listName :: Name 113 | listName = mkNameG TcClsName "ghc-prim" "GHC.Types" "[]" 114 | 115 | makeFuncT :: Type -> Type -> Type 116 | makeFuncT a = AppT (AppT ArrowT a) 117 | 118 | conArgTypes :: Con -> [Type] 119 | conArgTypes (NormalC _ args) = map snd args 120 | conArgTypes (RecC _ args) = map (\(_,_,x) -> x) args 121 | conArgTypes (InfixC arg1 _ arg2) = map snd [arg1, arg2] 122 | conArgTypes (ForallC _ _ c) = conArgTypes c 123 | #if MIN_VERSION_template_haskell(2,11,0) 124 | conArgTypes (GadtC _ args _) = map snd args 125 | conArgTypes (RecGadtC _ args _) = map (\(_,_,x) -> x) args 126 | #endif 127 | 128 | conName :: Con -> Name 129 | conName (NormalC n _) = n 130 | conName (RecC n _) = n 131 | conName (InfixC _ n _) = n 132 | conName (ForallC _ _ c) = conName c 133 | -- How to handle these? Both constructor types take a list of names - which 134 | -- (if any) of them should we pick? 135 | #if MIN_VERSION_template_haskell(2,11,0) 136 | conName (GadtC _ _ _) = undefined 137 | conName (RecGadtC _ _ _) = undefined 138 | #endif 139 | 140 | typeName :: Type -> Maybe Name 141 | typeName (AppT t _) = typeName t 142 | typeName (ConT n) = Just n 143 | typeName ListT = Just listName 144 | typeName _ = Nothing 145 | 146 | conType :: Name -> Name -> Con -> Type 147 | conType inputT resultT c = foldr makeFuncT (VarT resultT) argTypes 148 | where 149 | argTypes = map fixupArgType (conArgTypes c) 150 | 151 | fixupArgType t = case typeName t of 152 | Just n 153 | | n == inputT -> VarT resultT 154 | | n == listName -> AppT ListT (VarT resultT) 155 | | otherwise -> t 156 | Nothing -> t 157 | 158 | -- |The 'makeCata' function creates a catamorphism for the given type. 159 | makeCata :: CataOptions -- Options to customize the catamorphism; the name of the defined function can be changed 160 | -> Name -- The type to generate a catamorphism for. 161 | -> Q [Dec] 162 | makeCata opts ty = do 163 | typeInfo <- reify ty 164 | (tyVarBndrs, cons) <- case typeInfo of 165 | #if MIN_VERSION_template_haskell(2,11,0) 166 | TyConI (DataD _ _ tyVarBndrs _ cons _) -> return (tyVarBndrs, cons) 167 | TyConI (NewtypeD _ _ tyVarBndrs _ con _) -> return (tyVarBndrs, [con]) 168 | #else 169 | TyConI (DataD _ _ tyVarBndrs cons _) -> return (tyVarBndrs, cons) 170 | TyConI (NewtypeD _ _ tyVarBndrs con _) -> return (tyVarBndrs, [con]) 171 | #endif 172 | _ -> fail "makeCata: Expected name of type constructor" 173 | sequence [signature tyVarBndrs cons, funDef cons] 174 | where 175 | signature :: [TyVarBndr] -> [Con] -> Q Dec 176 | signature tyVarBndrs cons = do 177 | let tyVarNames = map tyVarName tyVarBndrs 178 | let typeConType = foldl AppT (ConT ty) (map VarT tyVarNames) 179 | resultTypeName <- newName "a" 180 | let args = map (conType ty resultTypeName) cons ++ [typeConType, VarT resultTypeName] 181 | return (SigD funName (ForallT (PlainTV resultTypeName : tyVarBndrs) [] (foldr1 makeFuncT args))) 182 | 183 | funDef :: [Con] -> Q Dec 184 | funDef cons = FunD funName . (:[]) <$> funImpl cons 185 | 186 | funName :: Name 187 | funName = mkName $ 188 | if null (cataName opts) 189 | then let (x:xs) = nameBase ty in toLower x : xs 190 | else cataName opts 191 | 192 | funImpl :: [Con] -> Q Clause 193 | funImpl cons = do 194 | conArgNames <- replicateM (length cons) (newName "c") 195 | 196 | valueArgName <- newName "x" 197 | let funArgs = map VarP (conArgNames ++ [valueArgName]) 198 | 199 | matches <- forM (zip cons conArgNames) $ \(c, cn) -> do 200 | pat@(ConP _ conPats) <- conToConP c 201 | let patNames = map (\(VarP n) -> n) conPats 202 | 203 | let translateArg t arg = case typeName t of 204 | Just n 205 | | n == ty -> foldl AppE (VarE funName) (map VarE (conArgNames ++ [arg])) 206 | | n == listName -> foldl1 AppE [VarE 'fmap, AppE (VarE funName) (VarE cn), VarE arg] 207 | | otherwise -> VarE arg 208 | Nothing -> VarE arg 209 | 210 | let argsWithTypes = zipWith translateArg (conArgTypes c) patNames 211 | let bodyE = foldl AppE (VarE cn) argsWithTypes 212 | return (Match pat (NormalB bodyE) []) 213 | 214 | let bodyE = CaseE (VarE valueArgName) matches 215 | return (Clause funArgs (NormalB bodyE) []) 216 | 217 | where 218 | conToConP :: Con -> Q Pat 219 | conToConP c = ConP (conName c) <$> replicateM (length . conArgTypes $ c) (VarP <$> newName "a") 220 | 221 | tyVarName :: TyVarBndr -> Name 222 | tyVarName (PlainTV n) = n 223 | tyVarName (KindedTV n _) = n 224 | 225 | -------------------------------------------------------------------------------- /test/Data/Morphism/CataSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | -- GHC 7.10 seems to require KindSignatures for the polymorph folds defined 6 | -- below. 7 | #if __GLASGOW_HASKELL__ >= 710 8 | {-# LANGUAGE KindSignatures #-} 9 | #endif 10 | 11 | module Data.Morphism.CataSpec (main, spec) where 12 | 13 | import Test.Hspec 14 | import Test.QuickCheck 15 | import Data.Morphism.Cata 16 | 17 | import Data.Bool (bool) 18 | import Data.Maybe (maybe) 19 | import Data.Either (either) 20 | 21 | data Unit = Unit 22 | data Binary = Zero | One 23 | data PolymorphSum a = PolymorphSum a 24 | data PolymorphProduct a b = PolymorphProduct a b 25 | data RegularRecursive a = Cons a (RegularRecursive a) | Empty 26 | data RoseTree a = Node a [RoseTree a] 27 | 28 | $(makeCata defaultOptions ''Unit) 29 | $(makeCata defaultOptions ''Binary) 30 | $(makeCata defaultOptions ''PolymorphSum) 31 | $(makeCata defaultOptions ''PolymorphProduct) 32 | $(makeCata defaultOptions ''RegularRecursive) 33 | $(makeCata defaultOptions { cataName = "binaryFold" } ''Binary) 34 | $(makeCata defaultOptions ''RoseTree) 35 | 36 | $(makeCata defaultOptions { cataName = "bool'" } ''Bool) 37 | $(makeCata defaultOptions { cataName = "maybe'" } ''Maybe) 38 | $(makeCata defaultOptions { cataName = "either'" } ''Either) 39 | $(makeCata defaultOptions { cataName = "foldr'" } ''[]) 40 | 41 | -- `main` is here so that this module can be run from GHCi on its own. It is 42 | -- not needed for automatic spec discovery. 43 | main :: IO () 44 | main = hspec spec 45 | 46 | spec :: Spec 47 | spec = do 48 | describe "type support" $ do 49 | it "handles Unit" $ do 50 | unit True Unit `shouldBe` True 51 | unit "foo" Unit `shouldBe` "foo" 52 | 53 | it "handles simple sum types" $ do 54 | binary 'z' 'o' Zero `shouldBe` 'z' 55 | binary 'z' 'o' One `shouldBe` 'o' 56 | 57 | it "handles polymorph sum types" $ do 58 | polymorphSum show (PolymorphSum True) `shouldBe` "True" 59 | polymorphSum length (PolymorphSum "Frerich") `shouldBe` 7 60 | 61 | it "handles polymorph product types" $ do 62 | let fn = (\b x -> show (if b then x + 1 else x - 1)) :: Bool -> Int -> String 63 | polymorphProduct fn (PolymorphProduct True 99) `shouldBe` "100" 64 | polymorphProduct fn (PolymorphProduct False 88) `shouldBe` "87" 65 | 66 | it "handles regular recursive types" $ do 67 | let length' = regularRecursive (\_ acc -> acc + 1) 0 :: RegularRecursive a -> Int 68 | length' Empty `shouldBe` 0 69 | length' (Cons () (Cons () (Cons () Empty))) `shouldBe` 3 70 | length' (Cons 'a' (Cons 'b' Empty)) `shouldBe` 2 71 | 72 | it "handles rose trees" $ do 73 | let treeSum = roseTree (\x xs -> sum (x:xs)) :: RoseTree Int -> Int 74 | treeSum (Node 3 []) `shouldBe` 3 75 | treeSum (Node 0 [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 [], Node 6 []], Node 7 [Node 8 [], Node 9 []]]) `shouldBe` 45 76 | 77 | describe "custom options" $ 78 | it "allows customizing the function name" $ do 79 | binaryFold 'z' 'o' Zero `shouldBe` 'z' 80 | binaryFold 'z' 'o' One `shouldBe` 'o' 81 | 82 | describe "equivalence" $ do 83 | let checkBinaryEquiv f g a b = property (\x -> f a b x == g a b x) 84 | 85 | it "can be used to define bool" $ 86 | checkBinaryEquiv bool bool' "false" "true" 87 | 88 | it "can be used to define maybe" $ 89 | checkBinaryEquiv maybe maybe' "" (++ "!!!") 90 | 91 | it "can be used to define either" $ 92 | checkBinaryEquiv either either' (show :: Bool -> String) (++ "!!!") 93 | 94 | it "can be used to define foldr" $ 95 | -- Well, we can get 'foldr', but flipped. 96 | checkBinaryEquiv foldr (flip foldr') (\(_ :: Int) (acc :: Int) -> acc + 1) 0 97 | -------------------------------------------------------------------------------- /test/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------