    {-|
        A Pseudo derivation. For every label, creates a function
        foo_u and foo_s which updates and sets the label respectively,
        e.g. 'foo_u (+1) bar' or 'foo_s 10 baz'
    -}
    module Data.Derive.Update(makeUpdate) where

    {-

    test :: Computer

    speed_u :: (Int -> Int) -> Computer -> Computer
    speed_u f x = x{speed = f (speed x)}

    speed_s :: Int -> Computer -> Computer
    speed_s v x = x{speed = v}

    weight_u :: (Double -> Double) -> Computer -> Computer
    weight_u f x = x{weight = f (weight x)}

    weight_s :: Double -> Computer -> Computer
    weight_s v x = x{weight = v}

    test :: Sample

    -}

    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