diff --git a/Data/Derive/All.hs b/Data/Derive/All.hs --- a/Data/Derive/All.hs +++ b/Data/Derive/All.hs @@ -25,6 +25,7 @@ import Data.Derive.Is as D import Data.Derive.JSON as D import Data.Derive.LazySet as D +import Data.Derive.Lens as D import Data.Derive.Monoid as D import Data.Derive.NFData as D import Data.Derive.Ord as D @@ -40,5 +41,5 @@ import Data.Derive.UniplateTypeable as D import Data.Derive.Update as D derivations :: [Derivation] -derivations = [makeArbitrary,makeArbitraryOld,makeArities,makeBinary,makeBinaryDefer,makeBounded,makeData,makeDataAbstract,makeDefault,makeEnum,makeEnumCyclic,makeEq,makeFold,makeFoldable,makeFrom,makeFunctor,makeHas,makeIs,makeJSON,makeLazySet,makeMonoid,makeNFData,makeOrd,makeRead,makeRef,makeSerial,makeSerialize,makeSet,makeShow,makeTraversable,makeTypeable,makeUniplateDirect,makeUniplateTypeable,makeUpdate] +derivations = [makeArbitrary,makeArbitraryOld,makeArities,makeBinary,makeBinaryDefer,makeBounded,makeData,makeDataAbstract,makeDefault,makeEnum,makeEnumCyclic,makeEq,makeFold,makeFoldable,makeFrom,makeFunctor,makeHas,makeIs,makeJSON,makeLazySet,makeLens,makeMonoid,makeNFData,makeOrd,makeRead,makeRef,makeSerial,makeSerialize,makeSet,makeShow,makeTraversable,makeTypeable,makeUniplateDirect,makeUniplateTypeable,makeUpdate] -- GENERATED STOP diff --git a/Data/Derive/Lens.hs b/Data/Derive/Lens.hs new file mode 100644 --- /dev/null +++ b/Data/Derive/Lens.hs @@ -0,0 +1,41 @@ +{-| + A pseudo derivation. For each field in the data type, deriving + @Lens@ generates @lens@/FieldName/@ = lens @/fieldName/@ + (\ x v -> v { @/fieldName/@ = x })@. + + This works with the @data-lens@ package. +-} +module Data.Derive.Lens(makeLens) where + +{- +import "data-lens" Data.Lens.Common + +test :: Sample + +test :: Computer + +lensSpeed :: Lens Computer Int +lensSpeed = lens speed (\x v -> v{speed = x}) + +lensWeight :: Lens Computer Double +lensWeight = lens weight (\x v -> v{weight = x}) +-} + +import Language.Haskell +import Data.Derive.Internal.Derivation + + +makeLens :: Derivation +makeLens = derivationCustom "Lens" $ \(_,d) -> Right $ concatMap (makeLensField d) $ dataDeclFields d + + +makeLensField :: DataDecl -> String -> [Decl] +makeLensField d field = [TypeSig sl [name ref] typ, bind ref [] bod] + where + ref = "lens" ++ title field + typ = tyApps (tyCon "Lens") [dataDeclType d, fromBangType t] + Just t = lookup field $ concatMap ctorDeclFields $ dataDeclCtors d + + bod = apps (var "lens") + [var field + ,Paren $ Lambda sl [pVar "x",pVar "v"] $ RecUpdate (var "v") [FieldUpdate (qname field) (var "x")]] diff --git a/Data/Derive/Typeable.hs b/Data/Derive/Typeable.hs --- a/Data/Derive/Typeable.hs +++ b/Data/Derive/Typeable.hs @@ -14,13 +14,13 @@ test :: Bool typename_Bool :: TyCon -typename_Bool = mkTyCon "Example.Bool" +typename_Bool = mkTyCon3 "package" "Example" "Bool" instance Typeable Bool where typeOf _ = mkTyConApp typename_Bool [] test :: Sample typename_Sample :: TyCon -typename_Sample = mkTyCon "Example.Sample" +typename_Sample = mkTyCon3 "package" "Example" "Sample" instance Typeable1 Sample where typeOf1 _ = mkTyConApp typename_Sample [] instance Typeable a => Typeable (Sample a) where @@ -28,7 +28,7 @@ test :: Either typename_Either :: TyCon -typename_Either = mkTyCon "Example.Either" +typename_Either = mkTyCon3 "package" "Example" "Either" instance Typeable2 Either where typeOf2 _ = mkTyConApp typename_Either [] instance Typeable a => Typeable1 (Either a) where @@ -77,7 +77,7 @@ mkTypeable modu d = [TypeSig sl [name fun] (tyCon "TyCon")] ++ [PatBind sl (pVar fun) Nothing (UnGuardedRhs bod) (BDecls []) | - let bod = App (var "mkTyCon") (Lit $ String $ modu ++ "." ++ nam)] ++ + let bod = apps (var "mkTyCon3") [Lit $ String "package", Lit $ String modu, Lit $ String nam]] ++ [inst [] (showN n) [tyCon nam] [PWildCard] $ apps (var "mkTyConApp") [var fun, List []]] ++ [inst [ClassA (qname "Typeable") [v] | v <- tvs] i [TyParen $ tyApp (tyCon nam) tvs] [] $ var $ "typeOf" ++ i ++ "Default" | (vs,i) <- zip (tail $ inits $ dataDeclVars d) $ map showN [n-1,n-2..] diff --git a/derive.cabal b/derive.cabal --- a/derive.cabal +++ b/derive.cabal @@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Default name: derive -version: 2.5.9 +version: 2.5.10 build-type: Simple copyright: Neil Mitchell 2006-2012 author: Neil Mitchell @@ -79,6 +79,7 @@ Data.Derive.Is Data.Derive.JSON Data.Derive.LazySet + Data.Derive.Lens Data.Derive.Monoid Data.Derive.NFData Data.Derive.Ord diff --git a/derive.htm b/derive.htm --- a/derive.htm +++ b/derive.htm @@ -112,6 +112,7 @@
  • Is
  • JSON - from the library json
  • LazySet
    • +
  • Lens - from the library data-lens
  • Monoid - from the library base
  • NFData - from the library deepseq
  • Ord - from the library base