module Run where

import           Control.Monad ((=<<), forever)
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class (lift)
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.State
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import           Data.Monoid ((<>), Last(..))
import qualified Data.Sequence as S
import           Data.Sequence (Seq, (<|), ViewL(..))
import           Data.Text (Text)

import Types
import Parse
import PSNum

pop :: Endsay Object
pop = Endsay $ do
  st <- lift get
  let x :< xs = S.viewl (isOpStack st)
  lift $ put st { isOpStack = xs }
  return x

push :: Object -> Endsay ()
push o = Endsay $ lift $ modify (\ s -> s { isOpStack = o <| isOpStack s })

pushObject :: ParsedObject -> Endsay ()
pushObject (POInteger n)    = push (OInteger n)
pushObject (POReal n)       = push (OReal n)
pushObject (PORadix _ n)    = push (OInteger n)
pushObject (POString t)     = push (OString t)
pushObject (POByteString t) = return ()
pushObject (POSymbol t)     = push (OName t)
pushObject (POName   t)     = runCommand t

runCommand :: Text -> Endsay ()
runCommand t = do
  obj <- findName t
  case obj of
    Nothing -> liftIO $ putStrLn "Name not found"
    Just (OBuiltInOperator (BuiltIn b)) -> b

runEndsay :: Text -> Endsay a -> IO (Either ESErr a, InterpreterState)
runEndsay t (Endsay mote) =
  runStateT (runExceptT mote) (initialInterpreterState t)
--  runStateT (runInterp mote) (runStateT (initialInterpreterState t) (runInterp mote))

findName :: Text -> Endsay (Maybe Object)
findName t = do
  InterpreterState { isDictStack = ds } <- Endsay $ lift get
  return $ getLast $ foldr (\ d r -> Last (HM.lookup t d) <> r) (Last Nothing) ds

step :: Endsay ()
step = do
  st <- Endsay $ lift get
  case pNextParsedObject (isParseState st) of
    Left err -> Endsay $ throwE (ESErr "unable to parse another thing")
    Right (po, st') -> do
      pushObject po
      Endsay $ lift $ modify $ \ s -> s { isParseState = st' }

run :: Endsay ()
run = forever step

initialInterpreterState :: Text -> InterpreterState
initialInterpreterState t = InterpreterState
  { isSource     = t
  , isParseState = initialParserState t
  , isOpStack    = S.empty
  , isDictStack  = S.singleton $ basicDict
  , isExecStack  = S.empty
  }

builtin :: Endsay () -> Object
builtin = OBuiltInOperator . BuiltIn

basicDict :: HashMap Text Object
basicDict = HM.fromList
  [ ("add", builtin $ do
        x <- toPSNum =<< pop
        y <- toPSNum =<< pop
        push (fromPSNum (x + y))
    )
  , ("sub", builtin $ do
        x <- toPSNum =<< pop
        y <- toPSNum =<< pop
        push (fromPSNum (x - y))
    )
  , ("mul", builtin $ do
        x <- toPSNum =<< pop
        y <- toPSNum =<< pop
        push (fromPSNum (x * y))
    )
  , ("lt", builtin $ do
        x <- toPSNum =<< pop
        y <- toPSNum =<< pop
        push (OBool (x < y))
    )
  , ("gt", builtin $ do
        x <- toPSNum =<< pop
        y <- toPSNum =<< pop
        push (OBool (x > y))
    )
  , ("dup", builtin $ do
        x <- pop
        push x
        push x
    )
  , ("exch", builtin $ do
        x <- pop
        y <- pop
        push x
        push x
    )
  , ("=", builtin $ pop >>= liftIO . print)
  ]