module SyntaxTrees.Purescript.Pattern where import Data.List (intercalate) import SyntaxTrees.Purescript.Common (Literal, QCtor, QCtorOp, Var) import Utils.String (Wrapper (Wrapper), joinMaybe, wrapCurlyCsv, wrapParens, wrapParensCsv, wrapSpaces, wrapSquareCsv, (+++)) data Pattern = CtorPattern { Pattern -> QCtor ctor :: QCtor , Pattern -> [Pattern] fields :: [Pattern] } | InfixCtorPattern { Pattern -> QCtorOp ctorOp :: QCtorOp , fields :: [Pattern] } | RecordPattern { ctor :: QCtor , Pattern -> [(Var, Maybe Pattern)] namedFields :: [(Var, Maybe Pattern)] } | AliasedPattern Var Pattern | ArrayPattern [Pattern] | TuplePattern [Pattern] | VarPattern Var | LitPattern Literal | Wildcard instance Show Pattern where show :: Pattern -> String show (CtorPattern QCtor x [Pattern] y) = forall a. Show a => a -> String show QCtor x String -> ShowS +++ forall a. [a] -> [[a]] -> [a] intercalate String " " (Pattern -> String showPatternNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Pattern] y) show (InfixCtorPattern QCtorOp x [Pattern] y) = forall a. [a] -> [[a]] -> [a] intercalate (ShowS wrapSpaces forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show QCtorOp x) (Pattern -> String showInfixPatternNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Pattern] y) show (RecordPattern QCtor x [(Var, Maybe Pattern)] y) = forall a. Show a => a -> String show QCtor x String -> ShowS +++ (forall a. Show a => [a] -> String wrapCurlyCsv forall a b. (a -> b) -> a -> b $ String -> Wrapper Wrapper forall b c a. (b -> c) -> (a -> b) -> a -> c . (Var, Maybe Pattern) -> String showRecordFieldPattern forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [(Var, Maybe Pattern)] y) show (AliasedPattern Var x Pattern y) = forall a. Show a => a -> String show Var x String -> ShowS +++ String "@" String -> ShowS +++ Pattern -> String showPatternNested Pattern y show (ArrayPattern [Pattern] x) = forall a. Show a => [a] -> String wrapSquareCsv [Pattern] x show (TuplePattern [Pattern x]) = forall a. Show a => a -> String show Pattern x show (TuplePattern [Pattern] x) = forall a. Show a => [a] -> String wrapParensCsv [Pattern] x show (VarPattern Var x) = forall a. Show a => a -> String show Var x show (LitPattern Literal x) = forall a. Show a => a -> String show Literal x show Pattern Wildcard = String "_" showRecordFieldPattern :: (Var, Maybe Pattern) -> String showRecordFieldPattern :: (Var, Maybe Pattern) -> String showRecordFieldPattern (Var x, Maybe Pattern y) = forall a. Show a => a -> String show Var x forall a. [a] -> [a] -> [a] ++ forall a. Show a => String -> Maybe a -> String joinMaybe String " =" Maybe Pattern y showInfixPatternNested :: Pattern -> String showInfixPatternNested :: Pattern -> String showInfixPatternNested Pattern x = ShowS transformFn forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Pattern x where transformFn :: ShowS transformFn = if Bool shouldWrap then ShowS wrapParens else forall a. a -> a id shouldWrap :: Bool shouldWrap = case Pattern x of (InfixCtorPattern QCtorOp _ [Pattern] _) -> Bool True Pattern _ -> Bool False showPatternNested :: Pattern -> String showPatternNested :: Pattern -> String showPatternNested Pattern x = ShowS transformFn forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Pattern x where transformFn :: ShowS transformFn = if Bool shouldWrap then ShowS wrapParens else forall a. a -> a id shouldWrap :: Bool shouldWrap = case Pattern x of (CtorPattern QCtor _ [Pattern] _) -> Bool True (InfixCtorPattern QCtorOp _ [Pattern] _) -> Bool True (AliasedPattern Var _ Pattern _) -> Bool True Pattern _ -> Bool False