module Data.Derive.Lens(makeLens) where
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")]]