{-# 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.Console.Haskeline
import qualified Data.Map as M
import Data.Text (unpack)

class Monad m => Interactive m where
    fread    :: Bool -> Name {- entity name -} -> m Funcons
    fprint   :: Name -> Values -> m ()
    fexec    :: m a -> InputValues -> IO (a, InputValues)

instance Interactive IO where
    fexec :: IO a -> InputValues -> IO (a, InputValues)
fexec IO a
ma InputValues
_ = (,InputValues
forall k a. Map k a
M.empty) (a -> (a, InputValues)) -> IO a -> IO (a, InputValues)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
ma

    fread :: Bool -> Name -> IO Funcons
fread Bool
str_inp Name
nm = Settings IO -> InputT IO Funcons -> IO Funcons
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
runInputT Settings IO
forall (m :: * -> *). MonadIO m => Settings m
defaultSettings (InputT IO Funcons -> IO Funcons)
-> InputT IO Funcons -> IO Funcons
forall a b. (a -> b) -> a -> b
$ do
        Maybe String
mLine <- String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
getInputLine String
prompt 
        case Maybe String
mLine of Maybe String
Nothing -> Funcons -> InputT IO Funcons
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Funcons
string_ String
"")
                      Just String
s  -> Funcons -> InputT IO Funcons
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Funcons
toFuncon String
s)
        where   toFuncon :: String -> Funcons
toFuncon  String
str | Bool
str_inp   = String -> Funcons
string_ String
str
                              | Bool
otherwise = String -> Funcons
fvalue_parse String
str
                prompt :: String
prompt | Name
nm Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"standard-in" = String
"\n> "
                       | Bool
otherwise =  String
"Please provide input for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
unpack Name
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"

    fprint :: Name -> Values -> IO ()
fprint Name
_ Values
v | Values -> Bool
forall t. HasValues t => Values t -> Bool
isString_ Values
v  = String -> IO ()
putStr (Values -> String
forall t. HasValues t => Values t -> String
unString Values
v)
               | Bool
otherwise    = String -> IO ()
putStr (Values -> String
showValues Values
v)

type SimIO = State InputValues 
runSimIO :: SimIO a -> InputValues -> (a, InputValues)
runSimIO :: SimIO a -> InputValues -> (a, InputValues)
runSimIO = SimIO a -> InputValues -> (a, InputValues)
forall s a. State s a -> s -> (a, s)
runState 

instance Interactive SimIO where
    fexec :: SimIO a -> InputValues -> IO (a, InputValues)
fexec SimIO a
ma InputValues
defs = (a, InputValues) -> IO (a, InputValues)
forall (m :: * -> *) a. Monad m => a -> m a
return (SimIO a -> InputValues -> (a, InputValues)
forall s a. State s a -> s -> (a, s)
runState SimIO a
ma InputValues
defs)
    
    fread :: Bool -> Name -> SimIO Funcons
fread Bool
_ Name
nm = do Funcons
v <- (InputValues -> Funcons) -> SimIO Funcons
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets InputValues -> Funcons
mLookup 
                    (InputValues -> InputValues) -> SimIO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Values] -> [Values]) -> Name -> InputValues -> InputValues
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust [Values] -> [Values]
forall a. [a] -> [a]
mTail Name
nm)
                    Funcons -> SimIO Funcons
forall (m :: * -> *) a. Monad m => a -> m a
return Funcons
v
        where mLookup :: InputValues -> Funcons
mLookup InputValues
m = case Name -> InputValues -> Maybe [Values]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
nm InputValues
m of
                  Just (Values
v:[Values]
_)  -> Values -> Funcons
FValue Values
v
                  Maybe [Values]
_           -> Values -> Funcons
FValue Values
forall t. Values t
null_value__ 
              mTail :: [a] -> [a]
mTail []     = []
              mTail (a
_:[a]
vs) = [a]
vs

    -- 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 :: Name -> Values -> SimIO ()
fprint Name
nm Values
v = () -> SimIO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
-----------