module Language.Haskell.Tools.AST.Gen.Exprs where
import Language.Haskell.Tools.AST
import Language.Haskell.Tools.AST.ElementTypes
import Language.Haskell.Tools.AST.Gen.Utils (mkAnn, mkAnnList, mkAnnMaybe)
import Language.Haskell.Tools.Transform
mkVar :: Name dom -> Expr dom
mkVar = mkAnn child . UVar
mkLit :: Literal dom -> Expr dom
mkLit = mkAnn child . ULit
mkInfixApp :: Expr dom -> Operator dom -> Expr dom -> Expr dom
mkInfixApp lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UInfixApp lhs op rhs
mkPrefixApp :: Operator dom -> Expr dom -> Expr dom
mkPrefixApp op rhs = mkAnn (child <> child) $ UPrefixApp op rhs
mkApp :: Expr dom -> Expr dom -> Expr dom
mkApp f e = mkAnn (child <> " " <> child) (UApp f e)
mkLambda :: [Pattern dom] -> Expr dom -> Expr dom
mkLambda pats rhs = mkAnn ("\\" <> child <> " -> " <> child) $ ULambda (mkAnnList (separatedBy " " list) pats) rhs
mkLet :: [LocalBind dom] -> Expr dom -> Expr dom
mkLet pats expr = mkAnn ("let " <> child <> " in " <> child) $ ULet (mkAnnList (indented list) pats) expr
mkIf :: Expr dom -> Expr dom -> Expr dom -> Expr dom
mkIf cond then_ else_ = mkAnn ("if " <> child <> " then " <> child <> " else " <> child) $ UIf cond then_ else_
mkMultiIf :: [GuardedCaseRhs dom] -> Expr dom
mkMultiIf cases = mkAnn ("if" <> child) $ UMultiIf (mkAnnList (indented list) cases)
mkCase :: Expr dom -> [Alt dom] -> Expr dom
mkCase expr cases = mkAnn ("case " <> child <> " of " <> child) $ UCase expr (mkAnnList (indented list) cases)
mkDoBlock :: [Stmt dom] -> Expr dom
mkDoBlock stmts = mkAnn (child <> " " <> child) $ UDo (mkAnn "do" UDoKeyword) (mkAnnList (indented list) stmts)
mkTuple :: [Expr dom] -> Expr dom
mkTuple exprs = mkAnn ("(" <> child <> ")") $ UTuple (mkAnnList (separatedBy ", " list) exprs)
mkUnboxedTuple :: [Expr dom] -> Expr dom
mkUnboxedTuple exprs = mkAnn ("(# " <> child <> " #)") $ UTuple (mkAnnList (separatedBy ", " list) exprs)
mkTupleSection :: [Maybe (Expr dom)] -> Expr dom
mkTupleSection elems
= let tupSecs = map (maybe (mkAnn "" Missing) (mkAnn child . Present)) elems
in mkAnn ("(" <> child <> ")") $ UTupleSection (mkAnnList (separatedBy ", " list) tupSecs)
mkTupleUnboxedSection :: [Maybe (Expr dom)] -> Expr dom
mkTupleUnboxedSection elems
= let tupSecs = map (maybe (mkAnn "" Missing) (mkAnn child . Present)) elems
in mkAnn ("(" <> child <> ")") $ UTupleSection (mkAnnList (separatedBy ", " list) tupSecs)
mkList :: [Expr dom] -> Expr dom
mkList exprs = mkAnn ("[" <> child <> "]") $ UList (mkAnnList (separatedBy ", " list) exprs)
mkParArray :: [Expr dom] -> Expr dom
mkParArray exprs = mkAnn ("[: " <> child <> " :]") $ UParArray (mkAnnList (separatedBy ", " list) exprs)
mkParen :: Expr dom -> Expr dom
mkParen = mkAnn ("(" <> child <> ")") . UParen
mkLeftSection :: Expr dom -> Operator dom -> Expr dom
mkLeftSection lhs op = mkAnn ("(" <> child <> " " <> child <> ")") $ ULeftSection lhs op
mkRightSection :: Operator dom -> Expr dom -> Expr dom
mkRightSection op rhs = mkAnn ("(" <> child <> " " <> child <> ")") $ URightSection op rhs
mkRecCon :: Name dom -> [FieldUpdate dom] -> Expr dom
mkRecCon name flds = mkAnn (child <> " { " <> child <> " }") $ URecCon name (mkAnnList (separatedBy ", " list) flds)
mkRecUpdate :: Expr dom -> [FieldUpdate dom] -> Expr dom
mkRecUpdate expr flds = mkAnn (child <> " { " <> child <> " }") $ URecUpdate expr (mkAnnList (separatedBy ", " list) flds)
mkEnum :: Expr dom -> Maybe (Expr dom) -> Maybe (Expr dom) -> Expr dom
mkEnum from step to = mkAnn ("[" <> child <> child <> ".." <> child <> "]") $ UEnum from (mkAnnMaybe (after "," opt) step) (mkAnnMaybe (after "," opt) to)
mkParArrayEnum :: Expr dom -> Maybe (Expr dom) -> Expr dom -> Expr dom
mkParArrayEnum from step to
= mkAnn ("[: " <> child <> child <> ".." <> child <> " :]")
$ UParArrayEnum from (mkAnnMaybe (after "," opt) step) to
mkListComp :: Expr dom -> [ListCompBody dom] -> Expr dom
mkListComp expr stmts
= mkAnn ("[ " <> child <> " | " <> child <> " ]")
$ UListComp expr $ mkAnnList (separatedBy " | " list) stmts
mkParArrayComp :: Expr dom -> [ListCompBody dom] -> Expr dom
mkParArrayComp expr stmts
= mkAnn ("[: " <> child <> " | " <> child <> " :]")
$ UParArrayComp expr $ mkAnnList (separatedBy " | " list) stmts
mkExprTypeSig :: Expr dom -> Type dom -> Expr dom
mkExprTypeSig lhs typ = mkAnn (child <> " :: " <> child) $ UTypeSig lhs typ
mkExplicitTypeApp :: Expr dom -> Type dom -> Expr dom
mkExplicitTypeApp expr typ = mkAnn (child <> " @" <> child) $ UExplTypeApp expr typ
mkVarQuote :: Name dom -> Expr dom
mkVarQuote = mkAnn ("'" <> child) . UVarQuote
mkTypeQuote :: Name dom -> Expr dom
mkTypeQuote = mkAnn ("''" <> child) . UTypeQuote
mkBracketExpr :: Bracket dom -> Expr dom
mkBracketExpr = mkAnn child . UBracketExpr
mkSpliceExpr :: Splice dom -> Expr dom
mkSpliceExpr = mkAnn child . USplice
mkQuasiQuoteExpr :: QuasiQuote dom -> Expr dom
mkQuasiQuoteExpr = mkAnn child . UQuasiQuoteExpr
mkExprPragma :: ExprPragma dom -> Expr dom -> Expr dom
mkExprPragma pragma expr = mkAnn (child <> " " <> child) $ UExprPragma pragma expr
mkProcExpr :: Pattern dom -> Cmd dom -> Expr dom
mkProcExpr pat cmd = mkAnn ("proc " <> child <> " -> " <> child) $ UProc pat cmd
mkArrowApp :: Expr dom -> ArrowApp dom -> Expr dom -> Expr dom
mkArrowApp lhs arrow rhs = mkAnn (child <> " " <> child <> " " <> child) $ UArrowApp lhs arrow rhs
mkLambdaCase :: [Alt dom] -> Expr dom
mkLambdaCase = mkAnn ("\\case" <> child) . ULamCase . mkAnnList (indented list)
mkStaticPointer :: Expr dom -> Expr dom
mkStaticPointer = mkAnn ("static" <> child) . UStaticPtr
mkFieldUpdate :: Name dom -> Expr dom -> FieldUpdate dom
mkFieldUpdate name val = mkAnn (child <> " = " <> child) $ UNormalFieldUpdate name val
mkFieldPun :: Name dom -> FieldUpdate dom
mkFieldPun name = mkAnn child $ UFieldPun name
mkFieldWildcard :: FieldUpdate dom
mkFieldWildcard = mkAnn child $ UFieldWildcard $ mkAnn ".." FldWildcard
mkAlt :: Pattern dom -> CaseRhs dom -> Maybe (LocalBinds dom) -> Alt dom
mkAlt pat rhs locals = mkAnn (child <> child <> child) $ UAlt pat rhs (mkAnnMaybe (after " where " opt) locals)
mkCaseRhs :: Expr dom -> CaseRhs dom
mkCaseRhs = mkAnn (" -> " <> child) . UUnguardedCaseRhs
mkGuardedCaseRhss :: [GuardedCaseRhs dom] -> CaseRhs dom
mkGuardedCaseRhss = mkAnn child . UGuardedCaseRhss . mkAnnList (indented list)
mkGuardedCaseRhs :: [RhsGuard dom] -> Expr dom -> GuardedCaseRhs dom
mkGuardedCaseRhs guards expr = mkAnn (" | " <> child <> " -> " <> child) $ UGuardedCaseRhs (mkAnnList (separatedBy ", " list) guards) expr
mkCorePragma :: String -> ExprPragma dom
mkCorePragma = mkAnn ("{-# CORE " <> child <> " #-}") . UCorePragma
. mkAnn ("\"" <> child <> "\"") . UStringNode
mkSccPragma :: String -> ExprPragma dom
mkSccPragma = mkAnn ("{-# SCC " <> child <> " #-}") . USccPragma
. mkAnn ("\"" <> child <> "\"") . UStringNode
mkGeneratedPragma :: SourceRange dom -> ExprPragma dom
mkGeneratedPragma = mkAnn ("{-# GENERATED " <> child <> " #-}") . UGeneratedPragma
mkSourceRange :: String -> Integer -> Integer -> Integer -> Integer -> SourceRange dom
mkSourceRange file fromLine fromCol toLine toCol
= mkAnn (child <> " " <> child <> ":" <> child <> "-" <> child <> ":" <> child)
$ USourceRange (mkAnn ("\"" <> child <> "\"") $ UStringNode file)
(mkNumber fromLine) (mkNumber fromCol) (mkNumber toLine) (mkNumber toCol)
where mkNumber = mkAnn child . Number
mkArrowAppCmd :: Expr dom -> ArrowApp dom -> Expr dom -> Cmd dom
mkArrowAppCmd lhs arrow rhs
= mkAnn (child <> " " <> child <> " " <> child)
$ UArrowAppCmd lhs arrow rhs
mkArrowFromCmd :: Expr dom -> [Cmd dom] -> Cmd dom
mkArrowFromCmd expr cmds
= mkAnn ("(| " <> child <> child <> " |)")
$ UArrowFormCmd expr $ mkAnnList (after " " $ separatedBy " " list) cmds
mkAppCmd :: Cmd dom -> Expr dom -> Cmd dom
mkAppCmd cmd expr = mkAnn (child <> " " <> child)
$ UAppCmd cmd expr
mkInfixCmd :: Cmd dom -> Name dom -> Cmd dom -> Cmd dom
mkInfixCmd lhs op rhs = mkAnn (child <> " " <> child <> " " <> child)
$ UInfixCmd lhs op rhs
mkLambdaCmd :: [Pattern dom] -> Cmd dom -> Cmd dom
mkLambdaCmd args cmd = mkAnn ("\\" <> child <> " -> " <> child)
$ ULambdaCmd (mkAnnList (separatedBy " " list) args) cmd
mkParenCmd :: Cmd dom -> Cmd dom
mkParenCmd cmd = mkAnn ("(" <> child <> ")") $ UParenCmd cmd
mkCaseCmd :: Expr dom -> [CmdAlt dom] -> Cmd dom
mkCaseCmd expr alts
= mkAnn ("case " <> child <> " of " <> child)
$ UCaseCmd expr $ mkAnnList (indented list) alts
mkIfCmd :: Expr dom -> Cmd dom -> Cmd dom -> Cmd dom
mkIfCmd pred then_ else_
= mkAnn ("if " <> child <> " then " <> child <> " else " <> child)
$ UIfCmd pred then_ else_
mkLetCmd :: [LocalBind dom] -> Cmd dom -> Cmd dom
mkLetCmd binds cmd
= mkAnn ("let " <> child <> " in " <> child)
$ ULetCmd (mkAnnList (indented list) binds) cmd
mkDoCmd :: [CmdStmt dom] -> Cmd dom
mkDoCmd stmts = mkAnn ("do " <> child) $ UDoCmd (mkAnnList (indented list) stmts)
mkLeftAppl :: ArrowApp dom
mkLeftAppl = mkAnn "-<" ULeftAppl
mkRightAppl :: ArrowApp dom
mkRightAppl = mkAnn ">-" URightAppl
mkLeftHighAppl :: ArrowApp dom
mkLeftHighAppl = mkAnn "-<<" ULeftHighApp
mkRightHighAppl :: ArrowApp dom
mkRightHighAppl = mkAnn ">>-" URightHighApp