genifunctors 0.3 → 0.4

raw patch · 3 files changed

+35/−35 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Generics/Genifunctors.hs +31/−34
• changelog +3/−0
• genifunctors.cabal +1/−1

@@ -42,6 +42,7 @@  import Control.Exception(assert) import Data.Maybe+import Data.Char  type GenM = RWST Generator [Dec] (Map Name Name) Q @@ -53,15 +54,15 @@  gen :: Generator -> Name -> Q Exp 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." +        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) @@ -118,7 +119,7 @@ -- -- @ --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+--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)@@ -178,12 +179,7 @@ foldMapType tc tvs = do     m <- newName "m"     from <- mapM (newName . nameBase) tvs-    return $ ForallT (map PlainTV (m : from))-#if MIN_VERSION_template_haskell(2,10,0)-                                              [AppT (ConT ''Monoid) (VarT m)]-#else-                                              [ClassP ''Monoid [VarT m]]-#endif+    return $ ForallT (map PlainTV (m : from)) [classType ''Monoid (VarT m)]            $ foldr arr                 (applyTyVars tc from `arr` VarT m)                 (zipWith arr (map VarT from) (repeat (VarT m)))@@ -193,12 +189,7 @@     f <- newName "f"     from <- mapM (newName . nameBase) tvs     to   <- mapM (newName . nameBase) tvs-    return $ ForallT (map PlainTV (f : from ++ to))-#if MIN_VERSION_template_haskell(2,10,0)-                                                    [AppT (ConT constraint_class) (VarT f)]-#else-                                                    [ClassP constraint_class [VarT f]]-#endif+    return $ ForallT (map PlainTV (f : from ++ to)) [classType constraint_class (VarT f)]            $ foldr arr                 (applyTyVars tc from `arr` (VarT f `AppT` applyTyVars tc to))                 (zipWith arr (map VarT from) (map (\ t -> VarT f `AppT` VarT t) to))@@ -260,12 +251,6 @@                 ]             return fn -newSanitizedName :: String -> Q Name-newSanitizedName nb = newName $ case nb of-    "[]" -> "_List"-    name | Just deg <- tupleDegreeMaybe name-             -> "_Tuple" ++ show deg-    name -> "_" ++ name  arr :: Type -> Type -> Type arr t1 t2 = (ArrowT `AppT` t1) `AppT` t2@@ -276,14 +261,36 @@ q :: Q a -> GenM a q = lift --- All the following functions are by Lennart in Geniplate+#if MIN_VERSION_template_haskell(2,10,0)+classType :: Name -> Type -> Type+classType name inst = AppT (ConT name) inst+#else+classType :: Name -> Type -> Pred+classType name inst = ClassP name [inst]+#endif +-- Contributed by Víctor López Juan, https://lopezjuan.com/+newSanitizedName :: String -> Q Name+newSanitizedName nb = newName $ '_':'N':(+    nb >>= \x -> case x of+      c | isAlphaNum c || c == '\''-> [c]+      '_' -> "__"+      c   -> "_" ++ show (ord c))++-- All the following functions are (originally) by Lennart in Geniplate+-- Move these to a TH-util package?+ getTyConInfo :: Name -> GenM ([Name], [Con]) getTyConInfo con = do     info <- q (reify con)     case info of+#if MIN_VERSION_template_haskell(2,11,0)+        TyConI (DataD _ _ tvs _ cs _) -> return (map unPlainTv tvs, cs)+        TyConI (NewtypeD _ _ tvs _ c _) -> return (map unPlainTv tvs, [c])+#else         TyConI (DataD _ _ tvs cs _) -> return (map unPlainTv tvs, cs)         TyConI (NewtypeD _ _ tvs c _) -> return (map unPlainTv tvs, [c])+#endif         PrimTyConI{} -> return ([], [])         i -> error $ "unexpected TyCon: " ++ show i   where@@ -333,13 +340,3 @@ subst s (SigT t k) = SigT (subst s t) k subst _ t = t --- Written by Richard Eisenberg in th-desugar--tupleDegreeMaybe :: String -> Maybe Int-tupleDegreeMaybe s = do-    '(' : s1 <- return s-    (commas, ")") <- return $ span (== ',') s1-    let degree-          | "" <- commas = 0-          | otherwise    = length commas + 1-    return degree

@@ -1,2 +1,5 @@+genifunctors 0.4 (released 2016-11-14)+	* Support GHC 8.0, contributed by Nick Smallbone.+ genifunctors 0.3 (released 2015-04-10) 	* Support GHC 7.10, contributed by Ryan Scott.

@@ -1,5 +1,5 @@ name:                genifunctors-version:             0.3+version:             0.4 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