{-# LANGUAGE DeriveFunctor #-}
module Test.IOTasks.IOrep (
  IOrep , Line,
  runProgram,
  MonadTeletype(..),
  -- ** Re-exports from "System.IO"
  BufferMode(..), stdout,
  ) where
import Prelude hiding (putChar,putStr,putStrLn,print,getChar,getLine,readLn)

import Data.Set (singleton)

import Control.Monad (ap, (>=>))

import Test.IOTasks.Trace
import Test.IOTasks.Internal.OutputPattern
import Test.IOTasks.MonadTeletype

import System.IO (BufferMode(..), stdout) -- for re-exports

data IOrep a
  = GetChar (Char -> IOrep a)
  | PutString String (IOrep a)
  | Return a
  deriving (forall a b. (a -> b) -> IOrep a -> IOrep b)
-> (forall a b. a -> IOrep b -> IOrep a) -> Functor IOrep
forall a b. a -> IOrep b -> IOrep a
forall a b. (a -> b) -> IOrep a -> IOrep b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> IOrep a -> IOrep b
fmap :: forall a b. (a -> b) -> IOrep a -> IOrep b
$c<$ :: forall a b. a -> IOrep b -> IOrep a
<$ :: forall a b. a -> IOrep b -> IOrep a
Functor

instance Applicative IOrep where
  <*> :: forall a b. IOrep (a -> b) -> IOrep a -> IOrep b
(<*>) = IOrep (a -> b) -> IOrep a -> IOrep b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
  pure :: forall a. a -> IOrep a
pure = a -> IOrep a
forall a. a -> IOrep a
Return

instance Monad IOrep where
  (Return a
a) >>= :: forall a b. IOrep a -> (a -> IOrep b) -> IOrep b
>>= a -> IOrep b
g = a -> IOrep b
g a
a
  (GetChar Char -> IOrep a
f) >>= a -> IOrep b
g = (Char -> IOrep b) -> IOrep b
forall a. (Char -> IOrep a) -> IOrep a
GetChar (Char -> IOrep a
f (Char -> IOrep a) -> (a -> IOrep b) -> Char -> IOrep b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> a -> IOrep b
g)
  (PutString String
s IOrep a
ma) >>= a -> IOrep b
g = String -> IOrep b -> IOrep b
forall a. String -> IOrep a -> IOrep a
putString String
s (IOrep a
ma IOrep a -> (a -> IOrep b) -> IOrep b
forall a b. IOrep a -> (a -> IOrep b) -> IOrep b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IOrep b
g)
  return :: forall a. a -> IOrep a
return = a -> IOrep a
forall a. a -> IOrep a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

putString :: String -> IOrep a -> IOrep a
putString :: forall a. String -> IOrep a -> IOrep a
putString String
s (PutString String
s' IOrep a
m) = String -> IOrep a -> IOrep a
forall a. String -> IOrep a -> IOrep a
PutString (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
s') IOrep a
m
putString String
s IOrep a
m = String -> IOrep a -> IOrep a
forall a. String -> IOrep a -> IOrep a
PutString String
s IOrep a
m

instance MonadTeletype IOrep where
  putChar :: Char -> IOrep ()
putChar Char
c = String -> IOrep () -> IOrep ()
forall a. String -> IOrep a -> IOrep a
putString [Char
c] (IOrep () -> IOrep ()) -> IOrep () -> IOrep ()
forall a b. (a -> b) -> a -> b
$ () -> IOrep ()
forall a. a -> IOrep a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  putStr :: String -> IOrep ()
putStr String
s = String -> IOrep () -> IOrep ()
forall a. String -> IOrep a -> IOrep a
putString String
s (IOrep () -> IOrep ()) -> IOrep () -> IOrep ()
forall a b. (a -> b) -> a -> b
$ () -> IOrep ()
forall a. a -> IOrep a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  getChar :: IOrep Char
getChar = (Char -> IOrep Char) -> IOrep Char
forall a. (Char -> IOrep a) -> IOrep a
GetChar Char -> IOrep Char
forall a. a -> IOrep a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

type Line = String

runProgram :: IOrep () -> [Line] -> NTrace
runProgram :: IOrep () -> [String] -> NTrace
runProgram (GetChar Char -> IOrep ()
_) [] = NTrace
NOutOfInputs
runProgram (GetChar Char -> IOrep ()
f) (String
"":[String]
is) = Char -> NTrace -> NTrace
NProgRead Char
'\n' (NTrace -> NTrace) -> NTrace -> NTrace
forall a b. (a -> b) -> a -> b
$ IOrep () -> [String] -> NTrace
runProgram (Char -> IOrep ()
f Char
'\n') [String]
is
runProgram (GetChar Char -> IOrep ()
f) ((Char
c:String
cs):[String]
is) = Char -> NTrace -> NTrace
NProgRead Char
c (NTrace -> NTrace) -> NTrace -> NTrace
forall a b. (a -> b) -> a -> b
$ IOrep () -> [String] -> NTrace
runProgram (Char -> IOrep ()
f Char
c) (String
csString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
is)
runProgram (PutString String
n IOrep ()
p') [String]
is = OptFlag -> Set (OutputPattern 'TraceP) -> NTrace -> NTrace
NProgWrite OptFlag
Mandatory (OutputPattern 'TraceP -> Set (OutputPattern 'TraceP)
forall a. a -> Set a
singleton (OutputPattern 'TraceP -> Set (OutputPattern 'TraceP))
-> OutputPattern 'TraceP -> Set (OutputPattern 'TraceP)
forall a b. (a -> b) -> a -> b
$ String -> OutputPattern 'TraceP
forall (k :: PatternKind). String -> OutputPattern k
Text String
n) (NTrace -> NTrace) -> NTrace -> NTrace
forall a b. (a -> b) -> a -> b
$ IOrep () -> [String] -> NTrace
runProgram IOrep ()
p' [String]
is
runProgram (Return ()) [String]
_ = NTrace
NTerminate