module APL.InterpPure (runEval) where

import APL.Monad

runEval :: EvalM a -> ([String], Either Error a)
runEval = runEval' envEmpty stateInitial
  where
    runEval' :: Env -> State -> EvalM a -> ([String], Either Error a)
    runEval' _ _ (Pure x) = ([], pure x)
    runEval' r s (Free (ReadOp k)) = runEval' r s $ k r
    runEval' r s (Free (StateGetOp k)) = runEval' r s $ k s
    runEval' r _ (Free (StatePutOp s' m)) = runEval' r s' m
    runEval' r s (Free (PrintOp p m)) =
      let (ps, res) = runEval' r s m
       in (p : ps, res)
    runEval' r s (Free (TryCatchOp m l)) =
      case (runEval' r s m) of
        (_, Left _) -> runEval' r s l
        a -> a
    runEval' r s (Free (KvGetOp key k)) =
      case (lookup key s) of
        Just val -> runEval' r s $ k val
        Nothing -> ([], Left ("Cannot find key: "++(show key)))
    runEval' r s (Free (KvPutOp key val m)) =
      runEval' r ((key,val):s) m
    runEval' r s (Free (TransactionOp l m)) =
      let (p, resl) = runEval' r s (do l >> getState)
      in case resl of
        Right s' ->
          let (ps, resm) = runEval' r s' m
          in (p ++ ps, resm)
        Left _ ->
          let (ps, resm) = runEval' r s m
          in (p ++ ps, resm)
    runEval' _ _ (Free (ErrorOp e)) = ([], Left e)