data-accessor-template 0.1.2 → 0.1.3

raw patch · 2 files changed

+30/−5 lines, 2 filesnew-uploaderPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

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

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

@@ -15,7 +15,7 @@   -- (Q, Exp(VarE), Pat(VarP), Dec(ValD), Name(Name), mkOccName, occString, reify, )  import Data.Maybe (catMaybes)-import Control.Monad (guard, liftM, )+import Control.Monad (guard, liftM, when)   @@ -27,7 +27,7 @@ -- It is "nameDeriveAccessors" n f where @f@ satisfies -- -- > f (s ++ "_") = Just s--- > f x          = x       -- otherwise+-- > f x          = Nothing    -- otherwise -- -- For example, given the data type: --@@ -43,6 +43,12 @@ -- > p2Score :: Accessor Score Int -- > p2Score = Accessor p2Score_ (\x s -> s { p2Score_ = x }) --+-- It is used with Template Haskell syntax like:+--+-- > $( deriveAccessors ''TypeName )+--+-- And will generate accessors when TypeName was declared+-- using @data@ or @newtype@. deriveAccessors :: Name -> Q [Dec] deriveAccessors n = nameDeriveAccessors n transformName     where@@ -58,10 +64,29 @@ -- field. nameDeriveAccessors :: Name -> (String -> Maybe String) -> Q [Dec] nameDeriveAccessors t namer = do-    TyConI (DataD _ _name _ cons _) <- reify t-    liftM concat $ mapM makeAccs cons+    info <- reify t+    reified <- case info of+                    TyConI dec -> return dec+                    _ -> fail errmsg+    cons <- case reified of+                 DataD _ _ _ cons' _ -> return cons'+                 NewtypeD _ _ _ con' _ -> return [con']+                 _ -> fail errmsg+    decs <- liftM concat $ mapM makeAccs cons+    when (null decs) $ qReport False nodefmsg+    return decs      where++    errmsg = "Cannot derive accessors for name " ++ show t ++ " because"+          ++ "\n    it is not a type declared with 'data' or 'newtype'"+          ++ "\n    Did you remember to double-tick the type as in"+          ++ "\n      $(deriveAccessors ''TheType)?"++    nodefmsg = "Warning: No accessors generated from the name " ++ show t+          ++ "\n    If you are using deriveAccessors rather than"+          ++ "\n    nameDeriveAccessors, remember accessors are"+          ++ "\n    only generated for fields ending with an underscore"      makeAccs :: Con -> Q [Dec]     makeAccs (RecC _ vars) =