module SemanticsException where

-- 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 monad type representing state and exception.
--
-- 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

instance Monad EM where
    return a = MkEM (\s -> (s, Right a))
    MkEM f >>= k = MkEM (\s0 -> case f s0 of
                            (s1, Left e) -> (s1, Left e)
                            (s1, Right a) -> unEM (k a) s1)
instance Applicative EM where
    pure = return
    mf <*> ma = mf >>= \f -> ma >>= \a -> return (f a)
instance Functor EM where
    fmap f ma = ma >>= \a -> return (f a)

-- Primitives for use by the interpreter.

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)

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