data-accessor-template 0.2.1.1 → 0.2.1.2
raw patch · 4 files changed
+284/−135 lines, 4 filesdep ~basedep ~data-accessordep ~template-haskellPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, data-accessor, template-haskell
API changes (from Hackage documentation)
Files
- data-accessor-template.cabal +29/−8
- src-3/Data/Accessor/Template.hs +127/−0
- src-5/Data/Accessor/Template.hs +128/−0
- src/Data/Accessor/Template.hs +0/−127
data-accessor-template.cabal view
@@ -1,5 +1,5 @@ Name: data-accessor-template-Version: 0.2.1.1+Version: 0.2.1.2 License: BSD3 License-File: LICENSE Author: Luke Palmer <lrpalmer@gmail.com>, Henning Thielemann <haskell@henning-thielemann.de>@@ -7,15 +7,36 @@ Homepage: http://www.haskell.org/haskellwiki/Record_access Package-URL: http://code.haskell.org/data-accessor/ Category: Data-Build-Type: Simple-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: Automate generation of @Accessor@'s of the @data-accessor@ package by Template Haskell functions.-GHC-Options: -Wall+Build-Type: Simple Tested-With: GHC==6.8.2-Hs-Source-Dirs: src-Exposed-Modules:- Data.Accessor.Template+Cabal-Version: >=1.2++Extra-Source-Files:+ src-3/Data/Accessor/Template.hs+ src-5/Data/Accessor/Template.hs++Flag template_2_4+ description: Adapt to TemplateHaskell version of GHC-6.12++Library+ Build-Depends:+ data-accessor >=0.1 && <0.4,+ utility-ht >=0.0.1 && <0.1,+ base >=1.0 && <6++ If flag(template_2_4)+ Hs-Source-Dirs: src-5+ Build-Depends: template-haskell >=2.4 && <2.5+ Else+ Hs-Source-Dirs: src-3+ Build-Depends: template-haskell >=2.2 && <2.4++ Exposed-Modules:+ Data.Accessor.Template++ Extensions: CPP, TemplateHaskell+ GHC-Options: -Wall
+ src-3/Data/Accessor/Template.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE TemplateHaskell, CPP #-}++{- |+This module provides an automatic Template Haskell+routine to scour data type definitions and generate+accessor objects for them automatically.+-}+module Data.Accessor.Template (+ nameDeriveAccessors, deriveAccessors,+ ) where++import qualified Data.Accessor.Basic as Accessor++import Language.Haskell.TH.Syntax+ -- (Q, Exp(VarE), Pat(VarP), Dec(ValD), Name(Name), mkOccName, occString, reify, )++import Data.List.HT (viewR, )+import Data.Maybe (catMaybes, )+import Control.Monad (liftM, when, )++++-- |@deriveAccessors n@ where @n@ is the name of a data type+-- declared with @data@ looks through all the declared fields+-- of the data type, and for each field ending in an underscore+-- generates an accessor of the same name without the underscore.+--+-- It is "nameDeriveAccessors" n f where @f@ satisfies+--+-- > f (s ++ "_") = Just s+-- > f x = Nothing -- otherwise+--+-- For example, given the data type:+--+-- > data Score = Score { p1Score_ :: Int+-- > , p2Score_ :: Int+-- > , rounds :: Int+-- > }+--+-- @deriveAccessors@ will generate the following objects:+--+-- > p1Score :: Accessor Score Int+-- > p1Score = Accessor p1Score_ (\x s -> s { p1Score_ = x })+-- > 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 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+-- @f@ returns @Nothing@, then no accessor is generated for that+-- field.+nameDeriveAccessors :: Name -> (String -> Maybe String) -> Q [Dec]+nameDeriveAccessors t namer = do+ info <- reify t+ reified <- case info of+ TyConI dec -> return dec+ _ -> fail errmsg+ (params, cons) <- case reified of+ DataD _ _ params cons' _ -> return (params, cons')+ NewtypeD _ _ params con' _ -> return (params, [con'])+ _ -> fail errmsg+ decs <- liftM concat $ mapM (makeAccs params) 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 :: [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 -> [Name] -> Type -> Q (Maybe [Dec])+ makeAccFromName name params ftype =+ case transformName name of+ Nothing -> return Nothing+ Just n -> liftM Just $ makeAcc name params ftype n++ -- haddock doesn't grok TH+#ifndef __HADDOCK__++ 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 ->+ $( return $ RecUpdE (VarE 's) [(name, VarE 'x)] ) )+ ( $( return $ VarE name ) )+ |]+ return+ [ SigD accName (ForallT params [] (AppT (AppT (ConT ''Accessor.T) appliedT) ftype))+ , ValD (VarP accName) (NormalB body) []+ ]++#endif
+ src-5/Data/Accessor/Template.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE TemplateHaskell, CPP #-}++{- |+This module provides an automatic Template Haskell+routine to scour data type definitions and generate+accessor objects for them automatically.+-}+module Data.Accessor.Template (+ nameDeriveAccessors, deriveAccessors,+ ) where++import qualified Data.Accessor.Basic as Accessor++import Language.Haskell.TH.Syntax+ -- (Q, Exp(VarE), Pat(VarP), Dec(ValD), Name(Name), mkOccName, occString, reify, )++import Data.List.HT (viewR, )+import Data.Maybe (catMaybes, )+import Control.Monad (liftM, when, )++++-- |@deriveAccessors n@ where @n@ is the name of a data type+-- declared with @data@ looks through all the declared fields+-- of the data type, and for each field ending in an underscore+-- generates an accessor of the same name without the underscore.+--+-- It is "nameDeriveAccessors" n f where @f@ satisfies+--+-- > f (s ++ "_") = Just s+-- > f x = Nothing -- otherwise+--+-- For example, given the data type:+--+-- > data Score = Score { p1Score_ :: Int+-- > , p2Score_ :: Int+-- > , rounds :: Int+-- > }+--+-- @deriveAccessors@ will generate the following objects:+--+-- > p1Score :: Accessor Score Int+-- > p1Score = Accessor p1Score_ (\x s -> s { p1Score_ = x })+-- > 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 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+-- @f@ returns @Nothing@, then no accessor is generated for that+-- field.+nameDeriveAccessors :: Name -> (String -> Maybe String) -> Q [Dec]+nameDeriveAccessors t namer = do+ info <- reify t+ reified <- case info of+ TyConI dec -> return dec+ _ -> fail errmsg+ (params, cons) <- case reified of+ DataD _ _ params cons' _ -> return (params, cons')+ NewtypeD _ _ params con' _ -> return (params, [con'])+ _ -> fail errmsg+ decs <- liftM concat $ mapM (makeAccs params) 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 :: [TyVarBndr] -> 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 -> [TyVarBndr] -> Type -> Q (Maybe [Dec])+ makeAccFromName name params ftype =+ case transformName name of+ Nothing -> return Nothing+ Just n -> liftM Just $ makeAcc name params ftype n++ -- haddock doesn't grok TH+#ifndef __HADDOCK__++ makeAcc ::Name -> [TyVarBndr] -> Type -> Name -> Q [Dec]+ makeAcc name params ftype accName = do+ let params' = map (\x -> case x of (PlainTV n) -> n; (KindedTV n _) -> n) params+ let appliedT = foldl AppT (ConT t) (map VarT params')+ body <- [|+ Accessor.fromSetGet+ ( \x s ->+ $( return $ RecUpdE (VarE 's) [(name, VarE 'x)] ) )+ ( $( return $ VarE name ) )+ |]+ return+ [ SigD accName (ForallT params [] (AppT (AppT (ConT ''Accessor.T) appliedT) ftype))+ , ValD (VarP accName) (NormalB body) []+ ]++#endif
− src/Data/Accessor/Template.hs
@@ -1,127 +0,0 @@-{-# LANGUAGE TemplateHaskell, CPP #-}--{- |-This module provides an automatic Template Haskell-routine to scour data type definitions and generate-accessor objects for them automatically.--}-module Data.Accessor.Template (- nameDeriveAccessors, deriveAccessors,- ) where--import qualified Data.Accessor.Basic as Accessor--import Language.Haskell.TH.Syntax- -- (Q, Exp(VarE), Pat(VarP), Dec(ValD), Name(Name), mkOccName, occString, reify, )--import Data.List.HT (viewR, )-import Data.Maybe (catMaybes, )-import Control.Monad (liftM, when, )------ |@deriveAccessors n@ where @n@ is the name of a data type--- declared with @data@ looks through all the declared fields--- of the data type, and for each field ending in an underscore--- generates an accessor of the same name without the underscore.------ It is "nameDeriveAccessors" n f where @f@ satisfies------ > f (s ++ "_") = Just s--- > f x = Nothing -- otherwise------ For example, given the data type:------ > data Score = Score { p1Score_ :: Int--- > , p2Score_ :: Int--- > , rounds :: Int--- > }------ @deriveAccessors@ will generate the following objects:------ > p1Score :: Accessor Score Int--- > p1Score = Accessor p1Score_ (\x s -> s { p1Score_ = x })--- > 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 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--- @f@ returns @Nothing@, then no accessor is generated for that--- field.-nameDeriveAccessors :: Name -> (String -> Maybe String) -> Q [Dec]-nameDeriveAccessors t namer = do- info <- reify t- reified <- case info of- TyConI dec -> return dec- _ -> fail errmsg- (params, cons) <- case reified of- DataD _ _ params cons' _ -> return (params, cons')- NewtypeD _ _ params con' _ -> return (params, [con'])- _ -> fail errmsg- decs <- liftM concat $ mapM (makeAccs params) 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 :: [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 -> [Name] -> Type -> Q (Maybe [Dec])- makeAccFromName name params ftype =- case transformName name of- Nothing -> return Nothing- Just n -> liftM Just $ makeAcc name params ftype n-- -- haddock doesn't grok TH-#ifndef __HADDOCK__-- 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 ->- $( return $ RecUpdE (VarE 's) [(name, VarE 'x)] ) )- ( $( return $ VarE name ) )- |]- return- [ SigD accName (ForallT params [] (AppT (AppT (ConT ''Accessor.T) appliedT) ftype))- , ValD (VarP accName) (NormalB body) []- ]--#endif