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