genifunctors 0.1.1.0 → 0.2.0.0

raw patch · 3 files changed

+131/−9 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Generics/Genifunctors.hs +55/−8
• Test.hs +63/−0
• genifunctors.cabal +13/−1

@@ -21,7 +21,17 @@ --travU :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (d -> f d') -> U a b c d -> f (U a' b' c' d') --travU = $(genTraverse ''U) -- @-module Data.Generics.Genifunctors (genFmap, genFoldMap, genTraverse) where+--+-- 'genFoldMapT' and 'genTraverseT' allow for specifying custom functions to handle+-- subparts of a specific type. The compiler will throw an error if any of the+-- types is actually a type synonym.+module Data.Generics.Genifunctors+  ( genFmap+  , genFoldMap+  , genFoldMapT+  , genTraverse+  , genTraverseT+  ) where  import Language.Haskell.TH import Control.Applicative@@ -42,11 +52,19 @@     }  gen :: Generator -> Name -> Q Exp-gen generator tc = do-    (fn,decls) <- evalRWST (generate tc) generator M.empty+gen g = genT g []+        +genT :: Generator -> [(Name,Name)] -> Name -> Q Exp+genT generator predef tc = do+    forM_ predef $ \(con,_) -> do+      info <- reify con+      case info of+        TyConI (TySynD{}) -> fail $ show con ++ " is a type synonym."+        TyConI _          -> return ()+        _                 -> fail $ show con ++ " is not a type constructor." +    (fn,decls) <- evalRWST (generate tc) generator $ M.fromList predef     return $ LetE decls (VarE fn) - -- | Generate generalized 'fmap' for a type -- -- @@@ -67,7 +85,20 @@ --foldMapEither = $(genFoldMap ''Either) -- @ genFoldMap :: Name -> Q Exp-genFoldMap = gen Generator+genFoldMap = genFoldMapT []++-- | Generate generalized 'foldMap' for a type, optionally traversing+--   subparts of it with custom implementations.+--+-- @+--foldTupleRev :: Monoid m => (a -> m) -> (b -> m) -> (a,b) -> m+--foldTupleRev f g (a,b) = g b <> f a+--+--foldUCustom :: Monoid m => (a -> m) -> (b -> m) -> (c -> m) -> (d -> m) -> U a b c d -> m+--foldUCustom = $(genFoldMapT [(''(,), 'foldTupleRev)] ''U)+-- @+genFoldMapT :: [(Name,Name)] -> Name -> Q Exp+genFoldMapT = genT Generator     { gen_combine   = foldMapCombine     , gen_primitive = foldMapPrimitive     , gen_type      = foldMapType@@ -80,7 +111,23 @@ --travTriple = $(genTraverse ''(,,)) -- @ genTraverse :: Name -> Q Exp-genTraverse = gen Generator+genTraverse = genTraverseT []++-- | Generate generalized 'traversable' for a type, optionally traversing+--   subparts of it with custom implementations.+--+-- @+--travTupleRev :: Applicative f => (a -> f a') -> (b -> f b') -> (a,b) -> f (a',b')+--travTupleRev f g (a,b) = (\b a -> (a,b)) <$> g b <*> f a+--+--travUCustom :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (d -> f d') -> U a b c d -> f (U a' b' c' d')+--travUCustom = $(genTraverseT [(''(,), 'travTupleRev), (''V, 'travVCustom)] ''U)+--+--travVCustom :: Applicative f => (a -> f a') -> (b -> f b') -> V a b -> f (V a' b')+--travVCustom = $(genTraverseT [(''U, 'travUCustom)] ''V)+-- @+genTraverseT :: [(Name, Name)] -> Name -> Q Exp+genTraverseT = genT Generator     { gen_combine   = traverseCombine     , gen_primitive = traversePrimitive     , gen_type      = traverseType ''Applicative@@ -90,8 +137,8 @@ fmapCombine con_name args = foldl AppE (ConE con_name) args  foldMapCombine :: Name -> [Exp] -> Exp-foldMapCombine _con_name []     = VarE 'mempty-foldMapCombine _con_name (a:as) = foldr (<<>>) a as+foldMapCombine _con_name [] = VarE 'mempty+foldMapCombine _con_name as = foldr1 (<<>>) as  traverseCombine :: Name -> [Exp] -> Exp traverseCombine con_name []     = VarE 'pure `AppE` ConE con_name

@@ -0,0 +1,63 @@+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Data.Generics.Genifunctors+import Data.Monoid+import Control.Applicative+import System.Exit++import TestTypes++import Control.Monad.Writer++fmapU :: (a -> a') -> (b -> b') -> (c -> c') -> (d -> d') -> U a b c d -> U a' b' c' d'+fmapU = $(genFmap ''U)++foldU :: Monoid m => (a -> m) -> (b -> m) -> (c -> m) -> (d -> m) -> U a b c d -> m+foldU = $(genFoldMap ''U)++travU :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (d -> f d') -> U a b c d -> f (U a' b' c' d')+travU = $(genTraverse ''U)++bimapTuple :: (a -> a') -> (b -> b') -> (a,b) -> (a',b')+bimapTuple = $(genFmap ''(,))++foldMapEither :: Monoid m => (a -> m) -> (b -> m) -> Either a b -> m+foldMapEither = $(genFoldMap ''Either)++travTriple :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (a,b,c) -> f (a',b',c')+travTriple = $(genTraverse ''(,,))++foldTupleRev :: Monoid m => (a -> m) -> (b -> m) -> (a,b) -> m+foldTupleRev f g (a,b) = g b `mappend` f a++foldUCustom :: Monoid m => (a -> m) -> (b -> m) -> (c -> m) -> (d -> m) -> U a b c d -> m+foldUCustom = $(genFoldMapT [(''(,), 'foldTupleRev)] ''U)++travTupleRev :: Applicative f => (a -> f a') -> (b -> f b') -> (a,b) -> f (a',b')+travTupleRev f g (a,b) = (\b a -> (a,b)) <$> g b <*> f a++travUCustom :: Applicative f => (a -> f a') -> (b -> f b') -> (c -> f c') -> (d -> f d') -> U a b c d -> f (U a' b' c' d')+travUCustom = $(genTraverseT [(''(,), 'travTupleRev), (''V, 'travVCustom)] ''U)++travVCustom :: Applicative f => (a -> f a') -> (b -> f b') -> V a b -> f (V a' b')+travVCustom = $(genTraverseT [(''U, 'travUCustom)] ''V)++assertEq :: (Show a,Eq a) => a -> a -> IO ()+assertEq a b | a == b = return ()+assertEq a b = do+  putStrLn $ show a ++ " /=\n" ++ show b+  exitFailure++main :: IO ()+main = do+    let v = L [0 :+: 1, M (X ((Right 5) :+: 4)), M (Z (2,3)), R 6 ""]+    assertEq (fmapU (+1) (+2) (+3) (+4) v) (L [1 :+: 1, M (X ((Right 9) :+: 4)), M (Z (3,5)), R 9 ""])+    let s = (:[])+    assertEq (foldU s s s s v) ([0,5,2,3,6])+    assertEq (foldUCustom s s s s v) ([0,5,3,2,6])+    let t = tell . s+    assertEq (execWriter (travU t t t t v)) ([0,5,2,3,6])+    assertEq (execWriter (travUCustom t t t t v)) ([0,5,3,2,6])++

@@ -1,5 +1,5 @@ name:                genifunctors-version:             0.1.1.0+version:             0.2.0.0 synopsis:            Generate generalized fmap, foldMap and traverse description:         Generate (derive) fmap, foldMap and traverse for Bifunctors, Trifunctors, or a functor with any arity license:             BSD3@@ -9,7 +9,13 @@ category:            Generics build-type:          Simple cabal-version:       >=1.10+homepage:            https://github.com/danr/genifunctors+bug-reports:         https://github.com/danr/genifunctors/issues +source-repository head+  type: git+  location: git://github.com/danr/genifunctors.git+ library     exposed-modules:     Data.Generics.Genifunctors     other-extensions:    TemplateHaskell, PatternGuards, RecordWildCards@@ -17,4 +23,10 @@                          template-haskell < 3,                          mtl,                          containers+    default-language:    Haskell2010++test-suite test+    type:                exitcode-stdio-1.0+    main-is:             Test.hs+    build-depends:       base, template-haskell < 3, mtl, containers     default-language:    Haskell2010