data-accessor-template 0.2.1 → 0.2.1.1

raw patch · 2 files changed

+18/−17 lines, 2 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• data-accessor-template.cabal +1/−1
• src/Data/Accessor/Template.hs +17/−16

@@ -1,5 +1,5 @@ Name:             data-accessor-template-Version:          0.2.1+Version:          0.2.1.1 License:          BSD3 License-File:     LICENSE Author:           Luke Palmer <lrpalmer@gmail.com>, Henning Thielemann <haskell@henning-thielemann.de>

@@ -56,7 +56,7 @@ stripUnderscore :: String -> Maybe String stripUnderscore s = do     (stem,'_') <- viewR s-    return $ stem+    return stem   -- |@nameDeriveAccessors n f@ where @n@ is the name of a data type@@ -70,11 +70,11 @@     reified <- case info of                     TyConI dec -> return dec                     _ -> fail errmsg-    cons <- case reified of-                 DataD _ _ _ cons' _ -> return cons'-                 NewtypeD _ _ _ con' _ -> return [con']+    (params, cons) <- case reified of+                 DataD _ _ params cons' _ -> return (params, cons')+                 NewtypeD _ _ params con' _ -> return (params, [con'])                  _ -> fail errmsg-    decs <- liftM concat $ mapM makeAccs cons+    decs <- liftM concat $ mapM (makeAccs params) cons     when (null decs) $ qReport False nodefmsg     return decs @@ -90,28 +90,29 @@           ++ "\n    nameDeriveAccessors, remember accessors are"           ++ "\n    only generated for fields ending with an underscore" -    makeAccs :: Con -> Q [Dec]-    makeAccs (RecC _ vars) =-        liftM (concat . catMaybes) $ mapM (\ (name,_,ftype) -> makeAccFromName name ftype) vars-    makeAccs (ForallC _ _ c) = makeAccs c-    makeAccs _ = return []+    makeAccs :: [Name] -> Con -> Q [Dec]+    makeAccs params (RecC _ vars) =+        liftM (concat . catMaybes) $ mapM (\ (name,_,ftype) -> makeAccFromName name params ftype) vars+    makeAccs params (ForallC _ _ c) = makeAccs params c+    makeAccs _ _ = return []      transformName :: Name -> Maybe Name     transformName (Name occ f) = do         n <- namer (occString occ)         return $ Name (mkOccName n) f -    makeAccFromName :: Name -> Type -> Q (Maybe [Dec])-    makeAccFromName name ftype = do+    makeAccFromName :: Name -> [Name] -> Type -> Q (Maybe [Dec])+    makeAccFromName name params ftype =         case transformName name of             Nothing -> return Nothing-            Just n -> liftM Just $ makeAcc name ftype n+            Just n -> liftM Just $ makeAcc name params ftype n      -- haddock doesn't grok TH #ifndef __HADDOCK__ -    makeAcc :: Name -> Type -> Name -> Q [Dec]-    makeAcc name ftype accName = do+    makeAcc ::Name -> [Name] -> Type -> Name -> Q [Dec]+    makeAcc name params ftype accName = do+        let appliedT = foldl AppT (ConT t) (map VarT params)         body <- [|                  Accessor.fromSetGet                     ( \x s ->@@ -119,7 +120,7 @@                     ( $( return $ VarE name ) )                 |]         return-          [ SigD accName (AppT (AppT (ConT ''Accessor.T) (ConT t)) ftype)+          [ SigD accName (ForallT params [] (AppT (AppT (ConT ''Accessor.T) appliedT) ftype))           , ValD (VarP accName) (NormalB body) []           ]