{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Pattern synonyms for untyped terms
module Swarm.Language.Syntax.Pattern (
  Syntax,
  TSyntax,
  USyntax,
  sLoc,
  sTerm,
  sType,
  sComments,
  pattern Syntax,
  pattern CSyntax,
  pattern STerm,
  pattern TRequirements,
  pattern TPair,
  pattern TLam,
  pattern TApp,
  pattern (:$:),
  pattern TLet,
  pattern TTydef,
  pattern TBind,
  pattern TDelay,
  pattern TRcd,
  pattern TProj,
  pattern TAnnotate,
  pattern TSuspend,
  pattern TParens,
  Term,
  TTerm,
  UTerm,
  noLoc,
) where

import Control.Lens (makeLenses, pattern Empty)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Swarm.Language.Requirements.Type (Requirements)
import Swarm.Language.Syntax.AST
import Swarm.Language.Syntax.Comments
import Swarm.Language.Syntax.Loc
import Swarm.Language.TDVar
import Swarm.Language.Types

-- | Syntax without type annotations.
type Syntax = Syntax' ()

type Term = Term' ()

type TSyntax = Syntax' Polytype
type TTerm = Term' Polytype

type USyntax = Syntax' UType
type UTerm = Term' UType

-- | Raw parsed syntax, without comments or type annotations.
pattern Syntax :: SrcLoc -> Term -> Syntax
pattern $mSyntax :: forall {r}. Syntax -> (SrcLoc -> Term -> r) -> ((# #) -> r) -> r
$bSyntax :: SrcLoc -> Term -> Syntax
Syntax l t <- Syntax' l t _ ()
  where
    Syntax SrcLoc
l Term
t = SrcLoc -> Term -> Comments -> () -> Syntax
forall ty. SrcLoc -> Term' ty -> Comments -> ty -> Syntax' ty
Syntax' SrcLoc
l Term
t Comments
forall s. AsEmpty s => s
Empty ()

{-# COMPLETE Syntax #-}

-- | Untyped syntax with assocated comments.
pattern CSyntax :: SrcLoc -> Term -> Comments -> Syntax
pattern $mCSyntax :: forall {r}.
Syntax -> (SrcLoc -> Term -> Comments -> r) -> ((# #) -> r) -> r
$bCSyntax :: SrcLoc -> Term -> Comments -> Syntax
CSyntax l t cs = Syntax' l t cs ()

{-# COMPLETE CSyntax #-}

makeLenses ''Syntax'

noLoc :: Term -> Syntax
noLoc :: Term -> Syntax
noLoc = SrcLoc -> Term -> Syntax
Syntax SrcLoc
forall a. Monoid a => a
mempty

-- | Match an untyped term without annotations.
pattern STerm :: Term -> Syntax
pattern $mSTerm :: forall {r}. Syntax -> (Term -> r) -> ((# #) -> r) -> r
$bSTerm :: Term -> Syntax
STerm t <-
  CSyntax _ t _
  where
    STerm Term
t = SrcLoc -> Term -> Syntax
Syntax SrcLoc
forall a. Monoid a => a
mempty Term
t

pattern TRequirements :: Text -> Term -> Term
pattern $mTRequirements :: forall {r}. Term -> (Var -> Term -> r) -> ((# #) -> r) -> r
$bTRequirements :: Var -> Term -> Term
TRequirements x t = SRequirements x (STerm t)

-- | Match a TPair without annotations.
pattern TPair :: Term -> Term -> Term
pattern $mTPair :: forall {r}. Term -> (Term -> Term -> r) -> ((# #) -> r) -> r
$bTPair :: Term -> Term -> Term
TPair t1 t2 = SPair (STerm t1) (STerm t2)

-- | Match a TLam without annotations.
pattern TLam :: Var -> Maybe Type -> Term -> Term
pattern $mTLam :: forall {r}.
Term -> (Var -> Maybe Type -> Term -> r) -> ((# #) -> r) -> r
$bTLam :: Var -> Maybe Type -> Term -> Term
TLam v ty t <- SLam (lvVar -> v) ty (STerm t)
  where
    TLam Var
v Maybe Type
ty Term
t = LocVar -> Maybe Type -> Syntax -> Term
forall ty. LocVar -> Maybe Type -> Syntax' ty -> Term' ty
SLam (SrcLoc -> Var -> LocVar
forall v. SrcLoc -> v -> Located v
LV SrcLoc
NoLoc Var
v) Maybe Type
ty (Term -> Syntax
STerm Term
t)

-- | Match a TApp without annotations.
pattern TApp :: Term -> Term -> Term
pattern $mTApp :: forall {r}. Term -> (Term -> Term -> r) -> ((# #) -> r) -> r
$bTApp :: Term -> Term -> Term
TApp t1 t2 = SApp (STerm t1) (STerm t2)

infixl 0 :$:

-- | Convenient infix pattern synonym for application.
pattern (:$:) :: Term -> Syntax -> Term
pattern $m:$: :: forall {r}. Term -> (Term -> Syntax -> r) -> ((# #) -> r) -> r
$b:$: :: Term -> Syntax -> Term
(:$:) t1 s2 = SApp (STerm t1) s2

-- | Match a TLet without annotations.
pattern TLet :: LetSyntax -> Bool -> Var -> Maybe RawPolytype -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term
pattern $mTLet :: forall {r}.
Term
-> (LetSyntax
    -> Bool
    -> Var
    -> Maybe RawPolytype
    -> Maybe Polytype
    -> Maybe Requirements
    -> Term
    -> Term
    -> r)
-> ((# #) -> r)
-> r
$bTLet :: LetSyntax
-> Bool
-> Var
-> Maybe RawPolytype
-> Maybe Polytype
-> Maybe Requirements
-> Term
-> Term
-> Term
TLet ls r v mty mpty mreq t1 t2 <- SLet ls r (lvVar -> v) mty mpty mreq (STerm t1) (STerm t2)
  where
    TLet LetSyntax
ls Bool
r Var
v Maybe RawPolytype
mty Maybe Polytype
mpty Maybe Requirements
mreq Term
t1 Term
t2 = LetSyntax
-> Bool
-> LocVar
-> Maybe RawPolytype
-> Maybe Polytype
-> Maybe Requirements
-> Syntax
-> Syntax
-> Term
forall ty.
LetSyntax
-> Bool
-> LocVar
-> Maybe RawPolytype
-> Maybe Polytype
-> Maybe Requirements
-> Syntax' ty
-> Syntax' ty
-> Term' ty
SLet LetSyntax
ls Bool
r (SrcLoc -> Var -> LocVar
forall v. SrcLoc -> v -> Located v
LV SrcLoc
NoLoc Var
v) Maybe RawPolytype
mty Maybe Polytype
mpty Maybe Requirements
mreq (Term -> Syntax
STerm Term
t1) (Term -> Syntax
STerm Term
t2)

-- | Match a STydef without annotations.
pattern TTydef :: TDVar -> Polytype -> Maybe TydefInfo -> Term -> Term
pattern $mTTydef :: forall {r}.
Term
-> (TDVar -> Polytype -> Maybe TydefInfo -> Term -> r)
-> ((# #) -> r)
-> r
$bTTydef :: TDVar -> Polytype -> Maybe TydefInfo -> Term -> Term
TTydef v ty mtd t1 <- STydef (lvVar -> v) ty mtd (STerm t1)
  where
    TTydef TDVar
v Polytype
ty Maybe TydefInfo
mtd Term
t1 = Located TDVar -> Polytype -> Maybe TydefInfo -> Syntax -> Term
forall ty.
Located TDVar
-> Polytype -> Maybe TydefInfo -> Syntax' ty -> Term' ty
STydef (SrcLoc -> TDVar -> Located TDVar
forall v. SrcLoc -> v -> Located v
LV SrcLoc
NoLoc TDVar
v) Polytype
ty Maybe TydefInfo
mtd (Term -> Syntax
STerm Term
t1)

-- | Match a TBind without annotations.
pattern TBind :: Maybe Var -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term
pattern $mTBind :: forall {r}.
Term
-> (Maybe Var
    -> Maybe Polytype -> Maybe Requirements -> Term -> Term -> r)
-> ((# #) -> r)
-> r
$bTBind :: Maybe Var
-> Maybe Polytype -> Maybe Requirements -> Term -> Term -> Term
TBind mv mty mreq t1 t2 <- SBind (fmap lvVar -> mv) _ mty mreq (STerm t1) (STerm t2)
  where
    TBind Maybe Var
mv Maybe Polytype
mty Maybe Requirements
mreq Term
t1 Term
t2 = Maybe LocVar
-> Maybe ()
-> Maybe Polytype
-> Maybe Requirements
-> Syntax
-> Syntax
-> Term
forall ty.
Maybe LocVar
-> Maybe ty
-> Maybe Polytype
-> Maybe Requirements
-> Syntax' ty
-> Syntax' ty
-> Term' ty
SBind (SrcLoc -> Var -> LocVar
forall v. SrcLoc -> v -> Located v
LV SrcLoc
NoLoc (Var -> LocVar) -> Maybe Var -> Maybe LocVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Var
mv) Maybe ()
forall a. Maybe a
Nothing Maybe Polytype
mty Maybe Requirements
mreq (Term -> Syntax
STerm Term
t1) (Term -> Syntax
STerm Term
t2)

-- | Match a TDelay without annotations.
pattern TDelay :: Term -> Term
pattern $mTDelay :: forall {r}. Term -> (Term -> r) -> ((# #) -> r) -> r
$bTDelay :: Term -> Term
TDelay t = SDelay (STerm t)

-- | Match a TRcd without annotations.
pattern TRcd :: Map Var (Maybe Term) -> Term
pattern $mTRcd :: forall {r}.
Term -> (Map Var (Maybe Term) -> r) -> ((# #) -> r) -> r
$bTRcd :: Map Var (Maybe Term) -> Term
TRcd m <- SRcd ((fmap . fmap) _sTerm -> m)
  where
    TRcd Map Var (Maybe Term)
m = Map Var (Maybe Syntax) -> Term
forall ty. Map Var (Maybe (Syntax' ty)) -> Term' ty
SRcd (((Maybe Term -> Maybe Syntax)
-> Map Var (Maybe Term) -> Map Var (Maybe Syntax)
forall a b. (a -> b) -> Map Var a -> Map Var b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Term -> Maybe Syntax)
 -> Map Var (Maybe Term) -> Map Var (Maybe Syntax))
-> ((Term -> Syntax) -> Maybe Term -> Maybe Syntax)
-> (Term -> Syntax)
-> Map Var (Maybe Term)
-> Map Var (Maybe Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term -> Syntax) -> Maybe Term -> Maybe Syntax
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Term -> Syntax
STerm Map Var (Maybe Term)
m)

pattern TProj :: Term -> Var -> Term
pattern $mTProj :: forall {r}. Term -> (Term -> Var -> r) -> ((# #) -> r) -> r
$bTProj :: Term -> Var -> Term
TProj t x = SProj (STerm t) x

-- | Match a TAnnotate without annotations.
pattern TAnnotate :: Term -> RawPolytype -> Term
pattern $mTAnnotate :: forall {r}. Term -> (Term -> RawPolytype -> r) -> ((# #) -> r) -> r
$bTAnnotate :: Term -> RawPolytype -> Term
TAnnotate t pt = SAnnotate (STerm t) pt

-- | Match a TSuspend without annotations.
pattern TSuspend :: Term -> Term
pattern $mTSuspend :: forall {r}. Term -> (Term -> r) -> ((# #) -> r) -> r
$bTSuspend :: Term -> Term
TSuspend t = SSuspend (STerm t)

-- | Match a TParens without annotations.
pattern TParens :: Term -> Term
pattern $mTParens :: forall {r}. Term -> (Term -> r) -> ((# #) -> r) -> r
$bTParens :: Term -> Term
TParens t = SParens (STerm t)

-- COMPLETE pragma tells GHC using this set of patterns is complete for Term

{-# COMPLETE TUnit, TConst, TDir, TInt, TAntiInt, TText, TAntiText, TBool, TRequire, TStock, TRequirements, TVar, TPair, TLam, TApp, TLet, TTydef, TBind, TDelay, TRcd, TProj, TAnnotate, TSuspend, TParens #-}