module Unison.Syntax.Pattern
  ( Pattern (..),
    setPos,
    SeqOp (..),
  )
where

import Unison.HashQualified (HashQualified)
import Unison.Name (Name)
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Syntax.Lexer.Token (Token)
import Unison.Syntax.Parser (Annotated (..))

data Pattern v
  = As Ann (Token v) (Pattern v)
  | Boolean Ann !Bool
  | Char Ann !Char
  | Constructor Ann !(Token (HashQualified Name)) [Pattern v]
  | EffectBind Ann !(Token (HashQualified Name)) [Pattern v] (Pattern v)
  | EffectPure Ann (Pattern v)
  | Float Ann !Double
  | Int Ann !Int64
  | Nat Ann !Word64
  | Pair Ann (Pattern v) (Pattern v)
  | SequenceLiteral Ann [Pattern v]
  | SequenceOp Ann (Pattern v) !SeqOp (Pattern v)
  | Text Ann !Text
  | Unbound Ann
  | Unit Ann
  | -- There's unfortunately no syntactic difference between nullary constructors and variables,
    -- so we can't commit to one or the other yet.
    VarOrNullaryConstructor Ann !(Token Name)
  deriving stock (Int -> Pattern v -> ShowS
[Pattern v] -> ShowS
Pattern v -> String
(Int -> Pattern v -> ShowS)
-> (Pattern v -> String)
-> ([Pattern v] -> ShowS)
-> Show (Pattern v)
forall v. Show v => Int -> Pattern v -> ShowS
forall v. Show v => [Pattern v] -> ShowS
forall v. Show v => Pattern v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Pattern v -> ShowS
showsPrec :: Int -> Pattern v -> ShowS
$cshow :: forall v. Show v => Pattern v -> String
show :: Pattern v -> String
$cshowList :: forall v. Show v => [Pattern v] -> ShowS
showList :: [Pattern v] -> ShowS
Show)

instance Annotated (Pattern v) where
  ann :: Pattern v -> Ann
ann = \case
    As Ann
pos Token v
_ Pattern v
_ -> Ann
pos
    Boolean Ann
pos Bool
_ -> Ann
pos
    Char Ann
pos Char
_ -> Ann
pos
    Constructor Ann
pos Token (HashQualified Name)
_ [Pattern v]
_ -> Ann
pos
    EffectBind Ann
pos Token (HashQualified Name)
_ [Pattern v]
_ Pattern v
_ -> Ann
pos
    EffectPure Ann
pos Pattern v
_ -> Ann
pos
    Float Ann
pos Double
_ -> Ann
pos
    Int Ann
pos Int64
_ -> Ann
pos
    Nat Ann
pos Word64
_ -> Ann
pos
    Pair Ann
pos Pattern v
_ Pattern v
_ -> Ann
pos
    SequenceLiteral Ann
pos [Pattern v]
_ -> Ann
pos
    SequenceOp Ann
pos Pattern v
_ SeqOp
_ Pattern v
_ -> Ann
pos
    Text Ann
pos Text
_ -> Ann
pos
    Unbound Ann
pos -> Ann
pos
    Unit Ann
pos -> Ann
pos
    VarOrNullaryConstructor Ann
pos Token Name
_ -> Ann
pos

setPos :: Ann -> Pattern v -> Pattern v
setPos :: forall v. Ann -> Pattern v -> Pattern v
setPos Ann
pos = \case
  As Ann
_ Token v
a Pattern v
b -> Ann -> Token v -> Pattern v -> Pattern v
forall v. Ann -> Token v -> Pattern v -> Pattern v
As Ann
pos Token v
a Pattern v
b
  Boolean Ann
_ Bool
a -> Ann -> Bool -> Pattern v
forall v. Ann -> Bool -> Pattern v
Boolean Ann
pos Bool
a
  Char Ann
_ Char
a -> Ann -> Char -> Pattern v
forall v. Ann -> Char -> Pattern v
Char Ann
pos Char
a
  Constructor Ann
_ Token (HashQualified Name)
a [Pattern v]
b -> Ann -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
forall v.
Ann -> Token (HashQualified Name) -> [Pattern v] -> Pattern v
Constructor Ann
pos Token (HashQualified Name)
a [Pattern v]
b
  EffectBind Ann
_ Token (HashQualified Name)
a [Pattern v]
b Pattern v
c -> Ann
-> Token (HashQualified Name)
-> [Pattern v]
-> Pattern v
-> Pattern v
forall v.
Ann
-> Token (HashQualified Name)
-> [Pattern v]
-> Pattern v
-> Pattern v
EffectBind Ann
pos Token (HashQualified Name)
a [Pattern v]
b Pattern v
c
  EffectPure Ann
_ Pattern v
a -> Ann -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> Pattern v
EffectPure Ann
pos Pattern v
a
  Float Ann
_ Double
a -> Ann -> Double -> Pattern v
forall v. Ann -> Double -> Pattern v
Float Ann
pos Double
a
  Int Ann
_ Int64
a -> Ann -> Int64 -> Pattern v
forall v. Ann -> Int64 -> Pattern v
Int Ann
pos Int64
a
  Nat Ann
_ Word64
a -> Ann -> Word64 -> Pattern v
forall v. Ann -> Word64 -> Pattern v
Nat Ann
pos Word64
a
  Pair Ann
_ Pattern v
a Pattern v
b -> Ann -> Pattern v -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> Pattern v -> Pattern v
Pair Ann
pos Pattern v
a Pattern v
b
  SequenceLiteral Ann
_ [Pattern v]
a -> Ann -> [Pattern v] -> Pattern v
forall v. Ann -> [Pattern v] -> Pattern v
SequenceLiteral Ann
pos [Pattern v]
a
  SequenceOp Ann
_ Pattern v
a SeqOp
b Pattern v
c -> Ann -> Pattern v -> SeqOp -> Pattern v -> Pattern v
forall v. Ann -> Pattern v -> SeqOp -> Pattern v -> Pattern v
SequenceOp Ann
pos Pattern v
a SeqOp
b Pattern v
c
  Text Ann
_ Text
a -> Ann -> Text -> Pattern v
forall v. Ann -> Text -> Pattern v
Text Ann
pos Text
a
  Unbound Ann
_ -> Ann -> Pattern v
forall v. Ann -> Pattern v
Unbound Ann
pos
  Unit Ann
_ -> Ann -> Pattern v
forall v. Ann -> Pattern v
Unit Ann
pos
  VarOrNullaryConstructor Ann
_ Token Name
a -> Ann -> Token Name -> Pattern v
forall v. Ann -> Token Name -> Pattern v
VarOrNullaryConstructor Ann
pos Token Name
a

data SeqOp
  = Concat
  | Cons
  | Snoc
  deriving stock (Int -> SeqOp -> ShowS
[SeqOp] -> ShowS
SeqOp -> String
(Int -> SeqOp -> ShowS)
-> (SeqOp -> String) -> ([SeqOp] -> ShowS) -> Show SeqOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SeqOp -> ShowS
showsPrec :: Int -> SeqOp -> ShowS
$cshow :: SeqOp -> String
show :: SeqOp -> String
$cshowList :: [SeqOp] -> ShowS
showList :: [SeqOp] -> ShowS
Show)