{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Tools.Rewrite.Create.Patterns where
import Language.Haskell.Tools.AST (UFieldWildcard(..), UPatternField(..), UPattern(..))
import Language.Haskell.Tools.PrettyPrint.Prepare
import Language.Haskell.Tools.Rewrite.Create.Utils (mkAnn, mkAnnList)
import Language.Haskell.Tools.Rewrite.ElementTypes
mkVarPat :: Name -> Pattern
mkVarPat = mkAnn child . UVarPat
mkLitPat :: Literal -> Pattern
mkLitPat = mkAnn child . ULitPat
mkInfixAppPat :: Pattern -> Operator -> Pattern -> Pattern
mkInfixAppPat lhs op rhs = mkAnn (child <> " " <> child <> " " <> child) $ UInfixAppPat lhs op rhs
mkAppPat :: Name -> [Pattern] -> Pattern
mkAppPat n pat = mkAnn (child <> child) $ UAppPat n (mkAnnList (after " " $ separatedBy " " list) pat)
mkTuplePat :: [Pattern] -> Pattern
mkTuplePat pats = mkAnn ("(" <> child <> ")") $ UTuplePat (mkAnnList (separatedBy ", " list) pats)
mkUnboxTuplePat :: [Pattern] -> Pattern
mkUnboxTuplePat pats = mkAnn ("(# " <> child <> " #)") $ UUnboxTuplePat (mkAnnList (separatedBy ", " list) pats)
mkListPat :: [Pattern] -> Pattern
mkListPat pats = mkAnn ("[" <> child <> "]") $ UListPat (mkAnnList (separatedBy ", " list) pats)
mkParArrayPat :: [Pattern] -> Pattern
mkParArrayPat pats = mkAnn ("[:" <> child <> ":]") $ UParArrPat (mkAnnList (separatedBy ", " list) pats)
mkParenPat :: Pattern -> Pattern
mkParenPat = mkAnn ("(" <> child <> ")") . UParenPat
mkRecPat :: Name -> [PatternField] -> Pattern
mkRecPat name flds = mkAnn (child <> "{ " <> child <> " }") $ URecPat name (mkAnnList (separatedBy ", " list) flds)
mkAsPat :: Name -> Pattern -> Pattern
mkAsPat name pat = mkAnn (child <> "@" <> child) $ UAsPat name pat
mkWildPat :: Pattern
mkWildPat = mkAnn "_" UWildPat
mkIrrefutablePat :: Pattern -> Pattern
mkIrrefutablePat = mkAnn ("~" <> child) . UIrrefutablePat
mkBangPat :: Pattern -> Pattern
mkBangPat = mkAnn ("!" <> child) . UBangPat
mkTypeSigPat :: Pattern -> Type -> Pattern
mkTypeSigPat pat typ = mkAnn (child <> " :: " <> child) $ UTypeSigPat pat typ
mkViewPat :: Expr -> Pattern -> Pattern
mkViewPat name pat = mkAnn (child <> " -> " <> child) $ UViewPat name pat
mkSplicePat :: Splice -> Pattern
mkSplicePat = mkAnn child . USplicePat
mkQuasiQuotePat :: QuasiQuote -> Pattern
mkQuasiQuotePat = mkAnn child . UQuasiQuotePat
mkPatternField :: Name -> Pattern -> PatternField
mkPatternField name pat = mkAnn (child <> " = " <> child) $ UNormalFieldPattern name pat
mkFieldPunPattern :: Name -> PatternField
mkFieldPunPattern name = mkAnn child $ UFieldPunPattern name
mkFieldWildcardPattern :: PatternField
mkFieldWildcardPattern = mkAnn child $ UFieldWildcardPattern $ mkAnn ".." FldWildcard