{-# LANGUAGE PatternSynonyms #-}

module TypedSession.State.Pattern where

import TypedSession.State.Type (Creat, Protocol)
import qualified TypedSession.State.Type as N

pattern Msg :: String -> [String] -> r -> r -> N.MsgOrLabel Creat r
pattern $mMsg :: forall {r} {r}.
MsgOrLabel Creat r
-> (String -> [String] -> r -> r -> r) -> ((# #) -> r) -> r
$bMsg :: forall r. String -> [String] -> r -> r -> MsgOrLabel Creat r
Msg a b c d = N.Msg () a b c d

pattern Label :: Int -> N.MsgOrLabel Creat r
pattern $mLabel :: forall {r} {r}.
MsgOrLabel Creat r -> (Int -> r) -> ((# #) -> r) -> r
$bLabel :: forall r. Int -> MsgOrLabel Creat r
Label i = N.Label () i

pattern BranchSt :: bst -> Protocol Creat r bst -> N.BranchSt Creat r bst
pattern $mBranchSt :: forall {r} {bst} {r}.
BranchSt Creat r bst
-> (bst -> Protocol Creat r bst -> r) -> ((# #) -> r) -> r
$bBranchSt :: forall bst r. bst -> Protocol Creat r bst -> BranchSt Creat r bst
BranchSt a b = N.BranchSt () a b

infixr 5 :>

pattern (:>) :: N.MsgOrLabel Creat r -> Protocol Creat r bst -> Protocol Creat r bst
pattern $m:> :: forall {r} {r} {bst}.
Protocol Creat r bst
-> (MsgOrLabel Creat r -> Protocol Creat r bst -> r)
-> ((# #) -> r)
-> r
$b:> :: forall r bst.
MsgOrLabel Creat r -> Protocol Creat r bst -> Protocol Creat r bst
(:>) a b = a N.:> b

pattern Branch :: r -> [N.BranchSt Creat r bst] -> Protocol Creat r bst
pattern $mBranch :: forall {r} {r} {bst}.
Protocol Creat r bst
-> (r -> [BranchSt Creat r bst] -> r) -> ((# #) -> r) -> r
$bBranch :: forall r bst. r -> [BranchSt Creat r bst] -> Protocol Creat r bst
Branch a b = N.Branch () a b

pattern Goto :: Int -> Protocol Creat r bst
pattern $mGoto :: forall {r} {r} {bst}.
Protocol Creat r bst -> (Int -> r) -> ((# #) -> r) -> r
$bGoto :: forall r bst. Int -> Protocol Creat r bst
Goto i = N.Goto () i

pattern Terminal :: Protocol Creat r bst
pattern $mTerminal :: forall {r} {r} {bst}.
Protocol Creat r bst -> ((# #) -> r) -> ((# #) -> r) -> r
$bTerminal :: forall r bst. Protocol Creat r bst
Terminal = N.Terminal ()