# OPTIONS_GHC -Wno - missing - export - lists #

module Reach.AST.EP where

import qualified Data.Map.Strict as M
import GHC.Generics
import Reach.AST.Base
import Reach.AST.DLBase
import Reach.Counter
import Reach.Pretty
import Reach.Texty

data ETail
  = ET_Com DLStmt ETail
  | ET_Stop SrcLoc
  | ET_If SrcLoc DLArg ETail ETail
  | ET_Switch SrcLoc DLVar (SwitchCases ETail)
  | ET_FromConsensus SrcLoc Int FromInfo ETail
  | ET_ToConsensus
      { et_tc_at :: SrcLoc
      , et_tc_from :: DLVar
      , et_tc_prev :: Int
      , et_tc_lct :: Maybe DLArg
      , et_tc_which :: Int
      , et_tc_from_me
        :: ( ---     args     amt   when   saved_vs just-me
             Maybe ([DLArg], DLPayAmt, DLArg, [DLVar], Bool)
             )
      , et_tc_from_msg :: [DLVar]
      , et_tc_from_out :: [DLVar]
      , et_tc_from_timev :: DLVar
      , et_tc_from_secsv :: DLVar
      , et_tc_from_didSendv :: DLVar
      , et_tc_from_mtime :: (Maybe (Maybe DLTimeArg, ETail))
      , et_tc_cons :: ETail
      }
  | ET_While
      { et_w_at :: SrcLoc
      , et_w_asn :: DLAssignment
      , et_w_cond :: DLBlock
      , et_w_body :: ETail
      , et_w_k :: ETail
      }
  | ET_Continue SrcLoc DLAssignment
  deriving (Eq)

instance SrcLocOf ETail where
  srclocOf = \case
    ET_Com c _ -> srclocOf c
    ET_Stop at -> at
    ET_If at _ _ _ -> at
    ET_Switch at _ _ -> at
    ET_FromConsensus at _ _ _ -> at
    ET_ToConsensus {..} -> et_tc_at
    ET_While {..} -> et_w_at
    ET_Continue at _ -> at

instance Pretty ETail where
  pretty e =
    case e of
      ET_Com c k -> pretty c <> hardline <> pretty k
      ET_Stop _ -> emptyDoc
      ET_If _ ca t f -> prettyIfp ca t f
      ET_Switch _ ov csm -> pretty $ SwitchCasesUse ov csm
      ET_FromConsensus _ which msvs k ->
        "fromConsensus" <+> whichp <+> pretty msvs <+> semi
          <> hardline
          <> pretty k
        where
          whichp = viaShow which
      ET_ToConsensus _ fs prev lct which msend msg out timev secsv didSendv mtime k ->
        msendp <> recvp <> mtimep <> kp
        where
          recvp =
            "recv"
              <> parens
                (render_obj $
                   M.fromList $
                     [ ("from" :: String, pretty fs)
                     , ("prev", pretty prev)
                     , ("lct", pretty lct)
                     , ("which", pretty which)
                     , ("msg", (cm $ map pretty msg))
                     , ("out", (cm $ map pretty out))
                     , ("timev", pretty timev)
                     , ("secsv", pretty secsv)
                     , ("didSendv", pretty didSendv)
                     ])
              <> hardline
          kp = ns $ pretty k
          msendp =
            case msend of
              Nothing -> mempty
              Just (as, amt, whena, saved, soloSend) ->
                "send"
                  <> parens
                    (render_obj $
                       M.fromList $
                         [ ("which" :: String, pretty which)
                         , ("as", cm $ map pretty as)
                         , ("amt", pretty amt)
                         , ("when", pretty whena)
                         , ("saved", cm $ map pretty saved)
                         , ("soloSend", pretty soloSend)
                         ])
                  <> hardline
          mtimep =
            case mtime of
              Nothing -> mempty
              Just (td, tl) ->
                "timeout" <> (cm [pretty td, (render_nest $ pretty tl)]) <> hardline
      ET_While _ asn cond body k ->
        prettyWhile asn () cond (pretty body) <> hardline <> pretty k
      ET_Continue _ asn -> prettyContinue asn
    where
      ns = render_nest
      cm l = parens (hsep $ punctuate comma $ l)

data EPart = EPart
  { ep_at :: SrcLoc
  , ep_isApi :: Bool
  , ep_interactEnv :: InteractEnv
  , ep_tail :: ETail
  }
  deriving (Eq)

instance Pretty EPart where
  pretty (EPart _ _ ep_interactEnv ep_tail) =
    pretty ep_interactEnv <> semi <> hardline <> pretty ep_tail

data EPOpts = EPOpts
  { epo_counter :: Counter
  }
  deriving (Generic, Eq)

instance HasCounter EPOpts where
  getCounter (EPOpts {..}) = epo_counter

type StateSrcMap = M.Map Int (SrcLoc, [SLCtxtFrame])

data EPProg = EPProg
  { epp_opts :: EPOpts
  , epp_init :: DLInit
  , epp_exports :: DLExports
  , epp_views :: DLViewsX
  , epp_stateSrcMap :: StateSrcMap
  , epp_apis :: DLAPIs
  , epp_events :: DLEvents
  , epp_m :: M.Map (SLPart, Maybe Int) EPart
  }
  deriving (Eq)

instance Pretty EPProg where
  pretty (EPProg {..}) =
    "EP" <+> render_obj (M.fromList $
      [ (("init"::String), pretty epp_init)
      , ("exports", pretty epp_exports)
      , ("apis", pretty epp_apis)
      , ("m", render_obj epp_m)
      ])

instance HasCounter EPProg where
  getCounter = getCounter . epp_opts

-     args     amt   when   saved_vs just-me
# OPTIONS_GHC -Wno - missing - export - lists #

module Reach.AST.EP where

import qualified Data.Map.Strict as M
import GHC.Generics
import Reach.AST.Base
import Reach.AST.DLBase
import Reach.Counter
import Reach.Pretty
import Reach.Texty

data ETail
  = ET_Com DLStmt ETail
  | ET_Stop SrcLoc
  | ET_If SrcLoc DLArg ETail ETail
  | ET_Switch SrcLoc DLVar (SwitchCases ETail)
  | ET_FromConsensus SrcLoc Int FromInfo ETail
  | ET_ToConsensus
      { et_tc_at :: SrcLoc
      , et_tc_from :: DLVar
      , et_tc_prev :: Int
      , et_tc_lct :: Maybe DLArg
      , et_tc_which :: Int
      , et_tc_from_me
             Maybe ([DLArg], DLPayAmt, DLArg, [DLVar], Bool)
             )
      , et_tc_from_msg :: [DLVar]
      , et_tc_from_out :: [DLVar]
      , et_tc_from_timev :: DLVar
      , et_tc_from_secsv :: DLVar
      , et_tc_from_didSendv :: DLVar
      , et_tc_from_mtime :: (Maybe (Maybe DLTimeArg, ETail))
      , et_tc_cons :: ETail
      }
  | ET_While
      { et_w_at :: SrcLoc
      , et_w_asn :: DLAssignment
      , et_w_cond :: DLBlock
      , et_w_body :: ETail
      , et_w_k :: ETail
      }
  | ET_Continue SrcLoc DLAssignment
  deriving (Eq)

instance SrcLocOf ETail where
  srclocOf = \case
    ET_Com c _ -> srclocOf c
    ET_Stop at -> at
    ET_If at _ _ _ -> at
    ET_Switch at _ _ -> at
    ET_FromConsensus at _ _ _ -> at
    ET_ToConsensus {..} -> et_tc_at
    ET_While {..} -> et_w_at
    ET_Continue at _ -> at

instance Pretty ETail where
  pretty e =
    case e of
      ET_Com c k -> pretty c <> hardline <> pretty k
      ET_Stop _ -> emptyDoc
      ET_If _ ca t f -> prettyIfp ca t f
      ET_Switch _ ov csm -> pretty $ SwitchCasesUse ov csm
      ET_FromConsensus _ which msvs k ->
        "fromConsensus" <+> whichp <+> pretty msvs <+> semi
          <> hardline
          <> pretty k
        where
          whichp = viaShow which
      ET_ToConsensus _ fs prev lct which msend msg out timev secsv didSendv mtime k ->
        msendp <> recvp <> mtimep <> kp
        where
          recvp =
            "recv"
              <> parens
                (render_obj $
                   M.fromList $
                     [ ("from" :: String, pretty fs)
                     , ("prev", pretty prev)
                     , ("lct", pretty lct)
                     , ("which", pretty which)
                     , ("msg", (cm $ map pretty msg))
                     , ("out", (cm $ map pretty out))
                     , ("timev", pretty timev)
                     , ("secsv", pretty secsv)
                     , ("didSendv", pretty didSendv)
                     ])
              <> hardline
          kp = ns $ pretty k
          msendp =
            case msend of
              Nothing -> mempty
              Just (as, amt, whena, saved, soloSend) ->
                "send"
                  <> parens
                    (render_obj $
                       M.fromList $
                         [ ("which" :: String, pretty which)
                         , ("as", cm $ map pretty as)
                         , ("amt", pretty amt)
                         , ("when", pretty whena)
                         , ("saved", cm $ map pretty saved)
                         , ("soloSend", pretty soloSend)
                         ])
                  <> hardline
          mtimep =
            case mtime of
              Nothing -> mempty
              Just (td, tl) ->
                "timeout" <> (cm [pretty td, (render_nest $ pretty tl)]) <> hardline
      ET_While _ asn cond body k ->
        prettyWhile asn () cond (pretty body) <> hardline <> pretty k
      ET_Continue _ asn -> prettyContinue asn
    where
      ns = render_nest
      cm l = parens (hsep $ punctuate comma $ l)

data EPart = EPart
  { ep_at :: SrcLoc
  , ep_isApi :: Bool
  , ep_interactEnv :: InteractEnv
  , ep_tail :: ETail
  }
  deriving (Eq)

instance Pretty EPart where
  pretty (EPart _ _ ep_interactEnv ep_tail) =
    pretty ep_interactEnv <> semi <> hardline <> pretty ep_tail

data EPOpts = EPOpts
  { epo_counter :: Counter
  }
  deriving (Generic, Eq)

instance HasCounter EPOpts where
  getCounter (EPOpts {..}) = epo_counter

type StateSrcMap = M.Map Int (SrcLoc, [SLCtxtFrame])

data EPProg = EPProg
  { epp_opts :: EPOpts
  , epp_init :: DLInit
  , epp_exports :: DLExports
  , epp_views :: DLViewsX
  , epp_stateSrcMap :: StateSrcMap
  , epp_apis :: DLAPIs
  , epp_events :: DLEvents
  , epp_m :: M.Map (SLPart, Maybe Int) EPart
  }
  deriving (Eq)

instance Pretty EPProg where
  pretty (EPProg {..}) =
    "EP" <+> render_obj (M.fromList $
      [ (("init"::String), pretty epp_init)
      , ("exports", pretty epp_exports)
      , ("apis", pretty epp_apis)
      , ("m", render_obj epp_m)
      ])

instance HasCounter EPProg where
  getCounter = getCounter . epp_opts
