data-accessor-template 0.2 → 0.2.1

raw patch · 2 files changed

+22/−17 lines, 2 filesdep +utility-htPVP ok

version bump matches the API change (PVP)

Dependencies added: utility-ht

API changes (from Hackage documentation)

Files

• data-accessor-template.cabal +2/−2
• src/Data/Accessor/Template.hs +20/−15

@@ -1,5 +1,5 @@ Name:             data-accessor-template-Version:          0.2+Version:          0.2.1 License:          BSD3 License-File:     LICENSE Author:           Luke Palmer <lrpalmer@gmail.com>, Henning Thielemann <haskell@henning-thielemann.de>@@ -8,7 +8,7 @@ Package-URL:      http://code.haskell.org/data-accessor/ Category:         Data Build-Type:       Simple-Build-Depends:    base>=1.0, data-accessor >=0.1 && <0.3, template-haskell+Build-Depends:    base>=1.0, data-accessor >=0.1 && <0.3, utility-ht >=0.0.1 && <0.1, template-haskell Extensions:       CPP, TemplateHaskell Synopsis:         Utilities for accessing and manipulating fields of records Description:

@@ -14,8 +14,9 @@ import Language.Haskell.TH.Syntax   -- (Q, Exp(VarE), Pat(VarP), Dec(ValD), Name(Name), mkOccName, occString, reify, ) -import Data.Maybe (catMaybes)-import Control.Monad (guard, liftM, when)+import Data.List.HT (viewR, )+import Data.Maybe (catMaybes, )+import Control.Monad (liftM, when, )   @@ -50,13 +51,14 @@ -- And will generate accessors when TypeName was declared -- using @data@ or @newtype@. deriveAccessors :: Name -> Q [Dec]-deriveAccessors n = nameDeriveAccessors n transformName-    where-    transformName s = do-        guard $ not (null s)-        guard $ last s == '_'-        return $ init s+deriveAccessors n = nameDeriveAccessors n stripUnderscore +stripUnderscore :: String -> Maybe String+stripUnderscore s = do+    (stem,'_') <- viewR s+    return $ stem++ -- |@nameDeriveAccessors n f@ where @n@ is the name of a data type -- declared with @data@ and @f@ is a function from names of fields -- in that data type to the name of the corresponding accessor. If@@ -90,7 +92,7 @@      makeAccs :: Con -> Q [Dec]     makeAccs (RecC _ vars) =-        liftM catMaybes $ mapM (\ (name,_,_) -> makeAccFromName name) vars+        liftM (concat . catMaybes) $ mapM (\ (name,_,ftype) -> makeAccFromName name ftype) vars     makeAccs (ForallC _ _ c) = makeAccs c     makeAccs _ = return [] @@ -99,23 +101,26 @@         n <- namer (occString occ)         return $ Name (mkOccName n) f -    makeAccFromName :: Name -> Q (Maybe Dec)-    makeAccFromName name = do+    makeAccFromName :: Name -> Type -> Q (Maybe [Dec])+    makeAccFromName name ftype = do         case transformName name of             Nothing -> return Nothing-            Just n -> liftM Just $ makeAcc name n+            Just n -> liftM Just $ makeAcc name ftype n      -- haddock doesn't grok TH #ifndef __HADDOCK__ -    makeAcc :: Name -> Name -> Q Dec-    makeAcc name accName = do+    makeAcc :: Name -> Type -> Name -> Q [Dec]+    makeAcc name ftype accName = do         body <- [|                  Accessor.fromSetGet                     ( \x s ->                         $( return $ RecUpdE (VarE 's) [(name, VarE 'x)] ) )                     ( $( return $ VarE name ) )                 |]-        return $ ValD (VarP accName) (NormalB body) []+        return+          [ SigD accName (AppT (AppT (ConT ''Accessor.T) (ConT t)) ftype)+          , ValD (VarP accName) (NormalB body) []+          ]  #endif