{-# LANGUAGE TupleSections, FlexibleInstances, OverloadedStrings,TypeSynonymInstances #-}
module Funcons.Simulation where
import Funcons.Types
import Funcons.Exceptions
import Funcons.Printer
import Funcons.Parser (fvalue_parse)
import Funcons.RunOptions
import Control.Applicative
import Control.Monad.State
import System.IO (hFlush,stdout)
import qualified Data.Map as M
import Data.Text (unpack)
class Monad m => Interactive m where
fread :: Bool -> Name -> m Funcons
fprint :: Name -> Values -> m ()
fexec :: m a -> InputValues -> IO (a, InputValues)
instance Interactive IO where
fexec ma _ = (,M.empty) <$> ma
fread str_inp nm = (case nm of
"standard-in" -> putStr "\n> " >> hFlush stdout
_ -> putStrLn ("Please provide input for " ++ unpack nm ++ ":"))
>> getLine >>= return . toFuncon
where toFuncon str | str_inp = string_ str
| otherwise = fvalue_parse str
fprint _ v | isString_ v = putStr (unString v)
| otherwise = putStr (showValues v)
type SimIO = State InputValues
runSimIO :: SimIO a -> InputValues -> (a, InputValues)
runSimIO = runState
instance Interactive SimIO where
fexec ma defs = return (runState ma defs)
fread _ nm = do v <- gets mLookup
modify (M.adjust mTail nm)
return v
where mLookup m = case M.lookup nm m of
Just (v:_) -> FValue v
_ -> FValue null_value__
mTail [] = []
mTail (_:vs) = vs
fprint nm v = return ()