module SemanticsException where

import Prelude hiding (pure, (>>=))

-- For simplicity, assume a global variable x.

data Expr = Num Integer
          | VarX                -- x
          | AssignX Expr        -- x := expr
          | Seq [Expr]          -- sequential execution
          | Raise Exception
          | CatcMyException Expr Expr -- try { expr } catch myexception { expr }
    deriving (Eq, Show)
-- Just enough to show my point: x value is preserved across exceptions.

-- Possible exceptions.
data Exception = MyException | AnotherException
    deriving (Eq, Show)

-- The type of possible answers from the interpreter.
data Value = VN Integer
           | VNone
    deriving (Eq, Show)


-- The model for exception with state.
--
-- The state is just one Value for my variable x.
--
-- BUT: state persists (not rolled back or backtracked) when exception happens.
-- So, NOT: Value -> Either Exception (Value, a).
data EM a = MkEM (Value -> (Value, Either Exception a))

unEM :: EM a -> Value -> (Value, Either Exception a)
unEM (MkEM f) = f

-- Connectives and primitives.

pure :: a -> EM a
pure a = MkEM (\s -> (s, Right a))

(>>=) :: EM a -> (a -> EM b) -> EM b
MkEM f >>= k = MkEM (\s0 -> case f s0 of
                        (s1, Left e) -> (s1, Left e)
                        (s1, Right a) -> unEM (k a) s1)

getX :: EM Value
getX = MkEM (\s -> (s, Right s))

setX :: Value -> EM ()
setX i = MkEM (\_ -> (i, Right ()))

raise :: Exception -> EM a
raise e = MkEM (\s -> (s, Left e))

-- 1st param: run this first
-- 2nd param: handler if myexception happens
catchMyException :: EM a -> EM a -> EM a
catchMyException (MkEM f) handler = MkEM (\s0 -> case f s0 of
                                             (s1, Left MyException) -> unEM handler s1
                                             othercases -> othercases)

-- The interpreter.

mainInterp :: Expr -> Either Exception Value
mainInterp expr = snd (unEM (interp expr) VNone)
-- So I'm using VNone to initialize x.

interp :: Expr -> EM Value

interp (Num i) = pure (VN i)

interp VarX = getX

interp (AssignX e) =
    interp e
    >>= \val -> setX val
    >>= \_ -> pure VNone

interp (Seq es) = go es
  where
    -- The answer of the whole Seq is VNone if the list is empty, else the
    -- answer from the last expression.  But still run all expressions for the
    -- effects.
    go [] = pure VNone
    go [e] = interp e
    go (e:es) = interp e >>= \_ -> go es

interp (Raise e) = raise e

interp (CatcMyException expr handler) = catchMyException (interp expr) (interp handler)


example = Seq [ AssignX (Num 10)              -- x := 10;
              , CatcMyException               -- try {
                  (Seq [ AssignX (Num 20)     --   x := 20;
                       , Raise MyException    --   raise myexception;
                       ])                     -- } catch myexception
                  (Seq [])                    --   {}
              , VarX                          -- read x
              ]
-- What should you get the end? 10? 20?
-- Test with: mainInterp example