Simulation.hs

{-# 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 ()
-----------