{- |
    Module      : $Header$
    Description : Utility functions for working with annotated FlatCurry.
    Copyright   : (c) 2016 - 2017 Finn Teegen
    License     : BSD-3-clause

    Maintainer  : bjp@informatik.uni-kiel.de
    Stability   : experimental
    Portability : portable

    TODO
-}

module Curry.FlatCurry.Annotated.Goodies
  ( module Curry.FlatCurry.Annotated.Goodies
  , module Curry.FlatCurry.Goodies
  ) where

import Curry.FlatCurry.Goodies ( Update
                               , trType, typeName, typeVisibility, typeParams
                               , typeConsDecls, typeSyn, isTypeSyn
                               , isDataTypeDecl, isExternalType, isPublicType
                               , updType, updTypeName, updTypeVisibility
                               , updTypeParams, updTypeConsDecls, updTypeSynonym
                               , updQNamesInType
                               , trCons, consName, consArity, consVisibility
                               , isPublicCons, consArgs, updCons, updConsName
                               , updConsArity, updConsVisibility, updConsArgs
                               , updQNamesInConsDecl
                               , tVarIndex, domain, range, tConsName, tConsArgs
                               , trTypeExpr, isTVar, isTCons, isFuncType
                               , updTVars, updTCons, updFuncTypes, argTypes
                               , typeArity, resultType, allVarsInTypeExpr
                               , allTypeCons, rnmAllVarsInTypeExpr
                               , updQNamesInTypeExpr
                               , trOp, opName, opFixity, opPrecedence, updOp
                               , updOpName, updOpFixity, updOpPrecedence
                               , trCombType, isCombTypeFuncCall
                               , isCombTypeFuncPartCall, isCombTypeConsCall
                               , isCombTypeConsPartCall
                               , isPublic
                               )

import Curry.FlatCurry.Annotated.Type

-- AProg ----------------------------------------------------------------------

-- |transform program
trAProg :: (String -> [String] -> [TypeDecl] -> [AFuncDecl a] -> [OpDecl] -> b)
        -> AProg a -> b
trAProg prog (AProg name imps types funcs ops) = prog name imps types funcs ops

-- Selectors

-- |get name from program
aProgName :: AProg a -> String
aProgName = trAProg (\name _ _ _ _ -> name)

-- |get imports from program
aProgImports :: AProg a -> [String]
aProgImports = trAProg (\_ imps _ _ _ -> imps)

-- |get type declarations from program
aProgTypes :: AProg a -> [TypeDecl]
aProgTypes = trAProg (\_ _ types _ _ -> types)

-- |get functions from program
aProgAFuncs :: AProg a -> [AFuncDecl a]
aProgAFuncs = trAProg (\_ _ _ funcs _ -> funcs)

-- |get infix operators from program
aProgOps :: AProg a -> [OpDecl]
aProgOps = trAProg (\_ _ _ _ ops -> ops)

-- Update Operations

-- |update program
updAProg :: (String -> String) ->
            ([String] -> [String]) ->
            ([TypeDecl] -> [TypeDecl]) ->
            ([AFuncDecl a] -> [AFuncDecl a]) ->
            ([OpDecl] -> [OpDecl]) -> AProg a -> AProg a
updAProg fn fi ft ff fo = trAProg prog
 where
  prog name imps types funcs ops
    = AProg (fn name) (fi imps) (ft types) (ff funcs) (fo ops)

-- |update name of program
updAProgName :: Update (AProg a) String
updAProgName f = updAProg f id id id id

-- |update imports of program
updAProgImports :: Update (AProg a) [String]
updAProgImports f = updAProg id f id id id

-- |update type declarations of program
updAProgTypes :: Update (AProg a) [TypeDecl]
updAProgTypes f = updAProg id id f id id

-- |update functions of program
updAProgAFuncs :: Update (AProg a) [AFuncDecl a]
updAProgAFuncs f = updAProg id id id f id

-- |update infix operators of program
updAProgOps :: Update (AProg a) [OpDecl]
updAProgOps = updAProg id id id id

-- Auxiliary Functions

-- |get all program variables (also from patterns)
allVarsInAProg :: AProg a -> [(VarIndex, a)]
allVarsInAProg = concatMap allVarsInAFunc . aProgAFuncs

-- |lift transformation on expressions to program
updAProgAExps :: Update (AProg a) (AExpr a)
updAProgAExps = updAProgAFuncs . map . updAFuncBody

-- |rename programs variables
rnmAllVarsInAProg :: Update (AProg a) VarIndex
rnmAllVarsInAProg = updAProgAFuncs . map . rnmAllVarsInAFunc

-- |update all qualified names in program
updQNamesInAProg :: Update (AProg a) QName
updQNamesInAProg f = updAProg id id
  (map (updQNamesInType f)) (map (updQNamesInAFunc f)) (map (updOpName f))

-- |rename program (update name of and all qualified names in program)
rnmAProg :: String -> AProg a -> AProg a
rnmAProg name p = updAProgName (const name) (updQNamesInAProg rnm p)
 where
  rnm (m, n) | m == aProgName p = (name, n)
             | otherwise = (m, n)

-- AFuncDecl ------------------------------------------------------------------

-- |transform function
trAFunc :: (QName -> Int -> Visibility -> TypeExpr -> ARule a -> b) -> AFuncDecl a -> b
trAFunc func (AFunc name arity vis t rule) = func name arity vis t rule

-- Selectors

-- |get name of function
aFuncName :: AFuncDecl a -> QName
aFuncName = trAFunc (\name _ _ _ _ -> name)

-- |get arity of function
aFuncArity :: AFuncDecl a -> Int
aFuncArity = trAFunc (\_ arity _ _ _ -> arity)

-- |get visibility of function
aFuncVisibility :: AFuncDecl a -> Visibility
aFuncVisibility = trAFunc (\_ _ vis _ _ -> vis)

-- |get type of function
aFuncType :: AFuncDecl a -> TypeExpr
aFuncType = trAFunc (\_ _ _ t _ -> t)

-- |get rule of function
aFuncARule :: AFuncDecl a -> ARule a
aFuncARule = trAFunc (\_ _ _ _ rule -> rule)

-- Update Operations

-- |update function
updAFunc :: (QName -> QName) ->
            (Int -> Int) ->
            (Visibility -> Visibility) ->
            (TypeExpr -> TypeExpr) ->
            (ARule a -> ARule a) -> AFuncDecl a -> AFuncDecl a
updAFunc fn fa fv ft fr = trAFunc func
 where
  func name arity vis t rule
    = AFunc (fn name) (fa arity) (fv vis) (ft t) (fr rule)

-- |update name of function
updAFuncName :: Update (AFuncDecl a) QName
updAFuncName f = updAFunc f id id id id

-- |update arity of function
updAFuncArity :: Update (AFuncDecl a) Int
updAFuncArity f = updAFunc id f id id id

-- |update visibility of function
updAFuncVisibility :: Update (AFuncDecl a) Visibility
updAFuncVisibility f = updAFunc id id f id id

-- |update type of function
updFuncType :: Update (AFuncDecl a) TypeExpr
updFuncType f = updAFunc id id id f id

-- |update rule of function
updAFuncARule :: Update (AFuncDecl a) (ARule a)
updAFuncARule = updAFunc id id id id

-- Auxiliary Functions

-- |is function public?
isPublicAFunc :: AFuncDecl a -> Bool
isPublicAFunc = isPublic . aFuncVisibility

-- |is function externally defined?
isExternal :: AFuncDecl a -> Bool
isExternal = isARuleExternal . aFuncARule

-- |get variable names in a function declaration
allVarsInAFunc :: AFuncDecl a -> [(VarIndex, a)]
allVarsInAFunc = allVarsInARule . aFuncARule

-- |get arguments of function, if not externally defined
aFuncArgs :: AFuncDecl a -> [(VarIndex, a)]
aFuncArgs = aRuleArgs . aFuncARule

-- |get body of function, if not externally defined
aFuncBody :: AFuncDecl a -> AExpr a
aFuncBody = aRuleBody . aFuncARule

-- |get the right-hand-sides of a 'FuncDecl'
aFuncRHS :: AFuncDecl a -> [AExpr a]
aFuncRHS f | not (isExternal f) = orCase (aFuncBody f)
           | otherwise = []
 where
  orCase e
    | isAOr e = concatMap orCase (orExps e)
    | isACase e = concatMap orCase (map aBranchAExpr (caseBranches e))
    | otherwise = [e]

-- |rename all variables in function
rnmAllVarsInAFunc :: Update (AFuncDecl a) VarIndex
rnmAllVarsInAFunc = updAFunc id id id id . rnmAllVarsInARule

-- |update all qualified names in function
updQNamesInAFunc :: Update (AFuncDecl a) QName
updQNamesInAFunc f = updAFunc f id id (updQNamesInTypeExpr f) (updQNamesInARule f)

-- |update arguments of function, if not externally defined
updAFuncArgs :: Update (AFuncDecl a) [(VarIndex, a)]
updAFuncArgs = updAFuncARule . updARuleArgs

-- |update body of function, if not externally defined
updAFuncBody :: Update (AFuncDecl a) (AExpr a)
updAFuncBody = updAFuncARule . updARuleBody

-- ARule ----------------------------------------------------------------------

-- |transform rule
trARule :: (a -> [(VarIndex, a)] -> AExpr a -> b) -> (a -> String -> b) -> ARule a -> b
trARule rule _ (ARule a args e) = rule a args e
trARule _ ext (AExternal a s) = ext a s

-- Selectors

-- |get rules annotation
aRuleAnnot :: ARule a -> a
aRuleAnnot = trARule (\a _ _ -> a) (\a _ -> a)

-- |get rules arguments if it's not external
aRuleArgs :: ARule a -> [(VarIndex, a)]
aRuleArgs = trARule (\_ args _ -> args) undefined

-- |get rules body if it's not external
aRuleBody :: ARule a -> AExpr a
aRuleBody = trARule (\_ _ e -> e) undefined

-- |get rules external declaration
aRuleExtDecl :: ARule a -> String
aRuleExtDecl = trARule undefined (\_ s -> s)

-- Test Operations

-- |is rule external?
isARuleExternal :: ARule a -> Bool
isARuleExternal = trARule (\_ _ _ -> False) (\_ _ -> True)

-- Update Operations

-- |update rule
updARule :: (a -> b) ->
            ([(VarIndex, a)] -> [(VarIndex, b)]) ->
            (AExpr a -> AExpr b) ->
            (String -> String) -> ARule a -> ARule b
updARule fannot fa fe fs = trARule rule ext
 where
  rule a args e = ARule (fannot a) (fa args) (fe e)
  ext a s = AExternal (fannot a) (fs s)

-- |update rules annotation
updARuleAnnot :: Update (ARule a) a
updARuleAnnot f = updARule f id id id

-- |update rules arguments
updARuleArgs :: Update (ARule a) [(VarIndex, a)]
updARuleArgs f = updARule id f id id

-- |update rules body
updARuleBody :: Update (ARule a) (AExpr a)
updARuleBody f = updARule id id f id

-- |update rules external declaration
updARuleExtDecl :: Update (ARule a) String
updARuleExtDecl f = updARule id id id f

-- Auxiliary Functions

-- |get variable names in a functions rule
allVarsInARule :: ARule a -> [(VarIndex, a)]
allVarsInARule = trARule (\_ args body -> args ++ allVars body) (\_ _ -> [])

-- |rename all variables in rule
rnmAllVarsInARule :: Update (ARule a) VarIndex
rnmAllVarsInARule f = updARule id (map (\(a, b) -> (f a, b))) (rnmAllVars f) id

-- |update all qualified names in rule
updQNamesInARule :: Update (ARule a) QName
updQNamesInARule = updARuleBody . updQNames

-- AExpr ----------------------------------------------------------------------

-- Selectors

-- |get annoation of an expression
annot :: AExpr a -> a
annot (AVar   a _    ) = a
annot (ALit   a _    ) = a
annot (AComb  a _ _ _) = a
annot (ALet   a _ _  ) = a
annot (AFree  a _ _  ) = a
annot (AOr    a _ _  ) = a
annot (ACase  a _ _ _) = a
annot (ATyped a _ _  ) = a

-- |get internal number of variable
varNr :: AExpr a -> VarIndex
varNr (AVar _ n) = n
varNr _          = error "Curry.FlatCurry.Annotated.Goodies.varNr: no variable"

-- |get literal if expression is literal expression
literal :: AExpr a -> Literal
literal (ALit _ l) = l
literal _          = error "Curry.FlatCurry.Annotated.Goodies.literal: no literal"

-- |get combination type of a combined expression
combType :: AExpr a -> CombType
combType (AComb _ ct _ _) = ct
combType _                = error $ "Curry.FlatCurry.Annotated.Goodies.combType: " ++
                                    "no combined expression"

-- |get name of a combined expression
combName :: AExpr a -> (QName, a)
combName (AComb _ _ name _) = name
combName _                  = error $ "Curry.FlatCurry.Annotated.Goodies.combName: " ++
                                      "no combined expression"

-- |get arguments of a combined expression
combArgs :: AExpr a -> [AExpr a]
combArgs (AComb _ _ _ args) = args
combArgs _                  = error $ "Curry.FlatCurry.Annotated.Goodies.combArgs: " ++
                                      "no combined expression"

-- |get number of missing arguments if expression is combined
missingCombArgs :: AExpr a -> Int
missingCombArgs = missingArgs . combType
  where
  missingArgs :: CombType -> Int
  missingArgs = trCombType 0 id 0 id

-- |get indices of varoables in let declaration
letBinds :: AExpr a -> [((VarIndex, a), AExpr a)]
letBinds (ALet _ vs _) = vs
letBinds _             = error $ "Curry.FlatCurry.Annotated.Goodies.letBinds: " ++
                                 "no let expression"

-- |get body of let declaration
letBody :: AExpr a -> AExpr a
letBody (ALet _ _ e) = e
letBody _            = error $ "Curry.FlatCurry.Annotated.Goodies.letBody: " ++
                               "no let expression"

-- |get variable indices from declaration of free variables
freeVars :: AExpr a -> [(VarIndex, a)]
freeVars (AFree _ vs _) = vs
freeVars _              = error $ "Curry.FlatCurry.Annotated.Goodies.freeVars: " ++
                                  "no declaration of free variables"

-- |get expression from declaration of free variables
freeExpr :: AExpr a -> AExpr a
freeExpr (AFree _ _ e) = e
freeExpr _             = error $ "Curry.FlatCurry.Annotated.Goodies.freeExpr: " ++
                                 "no declaration of free variables"

-- |get expressions from or-expression
orExps :: AExpr a -> [AExpr a]
orExps (AOr _ e1 e2) = [e1, e2]
orExps _             = error $ "Curry.FlatCurry.Annotated.Goodies.orExps: " ++
                               "no or expression"

-- |get case-type of case expression
caseType :: AExpr a -> CaseType
caseType (ACase _ ct _ _) = ct
caseType _                = error $ "Curry.FlatCurry.Annotated.Goodies.caseType: " ++
                                    "no case expression"

-- |get scrutinee of case expression
caseExpr :: AExpr a -> AExpr a
caseExpr (ACase _ _ e _) = e
caseExpr _               = error $ "Curry.FlatCurry.Annotated.Goodies.caseExpr: " ++
                                   "no case expression"


-- |get branch expressions from case expression
caseBranches :: AExpr a -> [ABranchExpr a]
caseBranches (ACase _ _ _ bs) = bs
caseBranches _                = error
  "Curry.FlatCurry.Annotated.Goodies.caseBranches: no case expression"

-- Test Operations

-- |is expression a variable?
isAVar :: AExpr a -> Bool
isAVar e = case e of
  AVar _ _ -> True
  _ -> False

-- |is expression a literal expression?
isALit :: AExpr a -> Bool
isALit e = case e of
  ALit _ _ -> True
  _ -> False

-- |is expression combined?
isAComb :: AExpr a -> Bool
isAComb e = case e of
  AComb _ _ _ _ -> True
  _ -> False

-- |is expression a let expression?
isALet :: AExpr a -> Bool
isALet e = case e of
  ALet _ _ _ -> True
  _ -> False

-- |is expression a declaration of free variables?
isAFree :: AExpr a -> Bool
isAFree e = case e of
  AFree _ _ _ -> True
  _ -> False

-- |is expression an or-expression?
isAOr :: AExpr a -> Bool
isAOr e = case e of
  AOr _ _ _ -> True
  _ -> False

-- |is expression a case expression?
isACase :: AExpr a -> Bool
isACase e = case e of
  ACase _ _ _ _ -> True
  _ -> False

-- |transform expression
trAExpr  :: (a -> VarIndex -> b)
         -> (a -> Literal -> b)
         -> (a -> CombType -> (QName, a) -> [b] -> b)
         -> (a -> [((VarIndex, a), b)] -> b -> b)
         -> (a -> [(VarIndex, a)] -> b -> b)
         -> (a -> b -> b -> b)
         -> (a -> CaseType -> b -> [c] -> b)
         -> (APattern a -> b -> c)
         -> (a -> b -> TypeExpr -> b)
         -> AExpr a
         -> b
trAExpr var lit comb lt fr oR cas branch typed expr = case expr of
  AVar a n             -> var a n
  ALit a l             -> lit a l
  AComb a ct name args -> comb a ct name (map f args)
  ALet a bs e          -> lt a (map (\(v, x) -> (v, f x)) bs) (f e)
  AFree a vs e         -> fr a vs (f e)
  AOr a e1 e2          -> oR a (f e1) (f e2)
  ACase a ct e bs      -> cas a ct (f e) (map (\ (ABranch p e') -> branch p (f e')) bs)
  ATyped a e ty        -> typed a (f e) ty
  where
  f = trAExpr var lit comb lt fr oR cas branch typed

-- |update all variables in given expression
updVars :: (a -> VarIndex -> AExpr a) -> AExpr a -> AExpr a
updVars var = trAExpr var ALit AComb ALet AFree AOr ACase ABranch ATyped

-- |update all literals in given expression
updLiterals :: (a -> Literal -> AExpr a) -> AExpr a -> AExpr a
updLiterals lit = trAExpr AVar lit AComb ALet AFree AOr ACase ABranch ATyped

-- |update all combined expressions in given expression
updCombs :: (a -> CombType -> (QName, a) -> [AExpr a] -> AExpr a) -> AExpr a -> AExpr a
updCombs comb = trAExpr AVar ALit comb ALet AFree AOr ACase ABranch ATyped

-- |update all let expressions in given expression
updLets :: (a -> [((VarIndex, a), AExpr a)] -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updLets lt = trAExpr AVar ALit AComb lt AFree AOr ACase ABranch ATyped

-- |update all free declarations in given expression
updFrees :: (a -> [(VarIndex, a)] -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updFrees fr = trAExpr AVar ALit AComb ALet fr AOr ACase ABranch ATyped

-- |update all or expressions in given expression
updOrs :: (a -> AExpr a -> AExpr a -> AExpr a) -> AExpr a -> AExpr a
updOrs oR = trAExpr AVar ALit AComb ALet AFree oR ACase ABranch ATyped

-- |update all case expressions in given expression
updCases :: (a -> CaseType -> AExpr a -> [ABranchExpr a] -> AExpr a) -> AExpr a -> AExpr a
updCases cas = trAExpr AVar ALit AComb ALet AFree AOr cas ABranch ATyped

-- |update all case branches in given expression
updBranches :: (APattern a -> AExpr a -> ABranchExpr a) -> AExpr a -> AExpr a
updBranches branch = trAExpr AVar ALit AComb ALet AFree AOr ACase branch ATyped

-- |update all typed expressions in given expression
updTypeds :: (a -> AExpr a -> TypeExpr -> AExpr a) -> AExpr a -> AExpr a
updTypeds = trAExpr AVar ALit AComb ALet AFree AOr ACase ABranch

-- Auxiliary Functions

-- |is expression a call of a function where all arguments are provided?
isFuncCall :: AExpr a -> Bool
isFuncCall e = isAComb e && isCombTypeFuncCall (combType e)

-- |is expression a partial function call?
isFuncPartCall :: AExpr a -> Bool
isFuncPartCall e = isAComb e && isCombTypeFuncPartCall (combType e)

-- |is expression a call of a constructor?
isConsCall :: AExpr a -> Bool
isConsCall e = isAComb e && isCombTypeConsCall (combType e)

-- |is expression a partial constructor call?
isConsPartCall :: AExpr a -> Bool
isConsPartCall e = isAComb e && isCombTypeConsPartCall (combType e)

-- |is expression fully evaluated?
isGround :: AExpr a -> Bool
isGround e
  = case e of
      AComb _ ConsCall _ args -> all isGround args
      _ -> isALit e

-- |get all variables (also pattern variables) in expression
allVars :: AExpr a -> [(VarIndex, a)]
allVars e = trAExpr var lit comb lt fr (const (.)) cas branch typ e []
 where
  var a v = (:) (v, a)
  lit = const (const id)
  comb _ _ _ = foldr (.) id
  lt _ bs e' = e' . foldr (.) id (map (\(n,ns) -> (n:) . ns) bs)
  fr _ vs e' = (vs++) . e'
  cas _ _ e' bs = e' . foldr (.) id bs
  branch pat e' = ((args pat)++) . e'
  typ _ = const
  args pat | isConsPattern pat = aPatArgs pat
           | otherwise = []

-- |rename all variables (also in patterns) in expression
rnmAllVars :: Update (AExpr a) VarIndex
rnmAllVars f = trAExpr var ALit AComb lt fr AOr ACase branch ATyped
 where
   var a = AVar a . f
   lt a = ALet a . map (\((n, b), e) -> ((f n, b), e))
   fr a = AFree a . map (\(b, c) -> (f b, c))
   branch = ABranch . updAPatArgs (map (\(a, b) -> (f a, b)))

-- |update all qualified names in expression
updQNames :: Update (AExpr a) QName
updQNames f = trAExpr AVar ALit comb ALet AFree AOr ACase branch ATyped
 where
  comb a ct (name, a') args = AComb a ct (f name, a') args
  branch = ABranch . updAPatCons (\(q, a) -> (f q, a))

-- ABranchExpr ----------------------------------------------------------------

-- |transform branch expression
trABranch :: (APattern a -> AExpr a -> b) -> ABranchExpr a -> b
trABranch branch (ABranch pat e) = branch pat e

-- Selectors

-- |get pattern from branch expression
aBranchAPattern :: ABranchExpr a -> APattern a
aBranchAPattern = trABranch (\pat _ -> pat)

-- |get expression from branch expression
aBranchAExpr :: ABranchExpr a -> AExpr a
aBranchAExpr = trABranch (\_ e -> e)

-- Update Operations

-- |update branch expression
updABranch :: (APattern a -> APattern a) -> (AExpr a -> AExpr a) -> ABranchExpr a -> ABranchExpr a
updABranch fp fe = trABranch branch
 where
  branch pat e = ABranch (fp pat) (fe e)

-- |update pattern of branch expression
updABranchAPattern :: Update (ABranchExpr a) (APattern a)
updABranchAPattern f = updABranch f id

-- |update expression of branch expression
updABranchAExpr :: Update (ABranchExpr a) (AExpr a)
updABranchAExpr = updABranch id

-- APattern -------------------------------------------------------------------

-- |transform pattern
trAPattern :: (a -> (QName, a) -> [(VarIndex, a)] -> b) -> (a -> Literal -> b) -> APattern a -> b
trAPattern pattern _ (APattern a name args) = pattern a name args
trAPattern _ lpattern (ALPattern a l) = lpattern a l

-- Selectors

-- |get annotation from pattern
aPatAnnot :: APattern a -> a
aPatAnnot = trAPattern (\a _ _ -> a) (\a _ -> a)

-- |get name from constructor pattern
aPatCons :: APattern a -> (QName, a)
aPatCons = trAPattern (\_ name _ -> name) undefined

-- |get arguments from constructor pattern
aPatArgs :: APattern a -> [(VarIndex, a)]
aPatArgs = trAPattern (\_ _ args -> args) undefined

-- |get literal from literal pattern
aPatLiteral :: APattern a -> Literal
aPatLiteral = trAPattern undefined (const id)

-- Test Operations

-- |is pattern a constructor pattern?
isConsPattern :: APattern a -> Bool
isConsPattern = trAPattern (\_ _ _ -> True) (\_ _ -> False)

-- Update Operations

-- |update pattern
updAPattern :: (a -> a) ->
               ((QName, a) -> (QName, a)) ->
               ([(VarIndex, a)] -> [(VarIndex, a)]) ->
               (Literal -> Literal) -> APattern a -> APattern a
updAPattern fannot fn fa fl = trAPattern pattern lpattern
 where
  pattern a name args = APattern (fannot a) (fn name) (fa args)
  lpattern a l = ALPattern (fannot a) (fl l)

-- |update annotation of pattern
updAPatAnnot :: (a -> a) -> APattern a -> APattern a
updAPatAnnot f = updAPattern f id id id

-- |update constructors name of pattern
updAPatCons :: ((QName, a) -> (QName, a)) -> APattern a -> APattern a
updAPatCons f = updAPattern id f id id

-- |update arguments of constructor pattern
updAPatArgs :: ([(VarIndex, a)] -> [(VarIndex, a)]) -> APattern a -> APattern a
updAPatArgs f = updAPattern id id f id

-- |update literal of pattern
updAPatLiteral :: (Literal -> Literal) -> APattern a -> APattern a
updAPatLiteral f = updAPattern id id id f

-- Auxiliary Functions

-- |build expression from pattern
aPatExpr :: APattern a -> AExpr a
aPatExpr = trAPattern (\a name -> AComb a ConsCall name . map (uncurry (flip AVar))) ALit