{-# LANGUAGE TupleSections, FlexibleInstances, OverloadedStrings #-} module Funcons.Simulation where import Funcons.Types import Funcons.Exceptions import Funcons.Printer import Funcons.RunOptions 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 Values --entity name 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 . toValue where toValue str | str_inp = String str | otherwise = read str fprint _ (String s) = putStr s fprint _ v = putStr (showValues v) type SimIO = State InputValues instance Interactive SimIO where fexec ma defs = return (runState ma defs) fread _ nm = do v <- gets mLookup modify (M.adjust tail nm) return v where mLookup m = case M.lookup nm m of Just (v:_) -> v _ -> error ("simulated IO: " ++ show (InsufficientInput nm)) -- SimIO ignores prints as simulated Output is always done -- alternative is to use tell from Writer monad here and somehow remember -- whatever has been printed in Interactive instance for IO -- (necessary for observing printed output by funcon defs, using 'readOUT') fprint nm v = return () -----------