module Data.Derive.Update(makeUpdate) where
import Language.Haskell
import Data.Derive.Internal.Derivation
import Data.Maybe
makeUpdate :: Derivation
makeUpdate = derivationCustom "Update" $ \(_,d) -> Right $ concatMap (makeUpdateField d) $ dataDeclFields d
makeUpdateField :: DataDecl -> String -> [Decl]
makeUpdateField d field =
[TypeSig sl [name upd] (TyParen (TyFun typF typF) `TyFun` typR)
,bind upd [pVar "f",pVar "x"] $ RecUpdate (var "x") [FieldUpdate (qname field) (App (var "f") (Paren $ App (var field) (var "x")))]
,TypeSig sl [name set] (typF `TyFun` typR)
,bind set [pVar "v",pVar "x"] $ RecUpdate (var "x") [FieldUpdate (qname field) (var "v")]]
where
set = field ++ "_s"
upd = field ++ "_u"
typR = dataDeclType d `TyFun` dataDeclType d
typF = fromBangType $ fromJust $ lookup field $ concatMap ctorDeclFields $ dataDeclCtors d