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