{- |
Module      : Language.Egison.Primitives.IO
Licence     : MIT

This module implements primitive functions that performs IO operations.
-}

module Language.Egison.Primitives.IO
  ( ioPrimitives
  ) where

import           Control.Monad.Except

import           Data.IORef

import           System.IO
import           System.Process                   (readProcess)
import           System.Random                    (getStdRandom, randomR)

import qualified Data.Text                        as T
import qualified Data.Text.IO                     as T

import           Language.Egison.Core             (evalWHNF)
import           Language.Egison.Data
import           Language.Egison.Primitives.Utils


--
-- IO Primitives
--

ioPrimitives :: [(String, EgisonValue)]
ioPrimitives :: [(String, EgisonValue)]
ioPrimitives =
  ((String, String -> PrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> PrimitiveFunc)] -> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> PrimitiveFunc
fn) -> (String
name, PrimitiveFunc -> EgisonValue
PrimitiveFunc (String -> PrimitiveFunc
fn String
name))) [(String, String -> PrimitiveFunc)]
ioStrictPrimitives [(String, EgisonValue)]
-> [(String, EgisonValue)] -> [(String, EgisonValue)]
forall a. [a] -> [a] -> [a]
++
    ((String, String -> LazyPrimitiveFunc) -> (String, EgisonValue))
-> [(String, String -> LazyPrimitiveFunc)]
-> [(String, EgisonValue)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
name, String -> LazyPrimitiveFunc
fn) -> (String
name, LazyPrimitiveFunc -> EgisonValue
LazyPrimitiveFunc (String -> LazyPrimitiveFunc
fn String
name))) [(String, String -> LazyPrimitiveFunc)]
ioLazyPrimitives

ioStrictPrimitives :: [(String, String -> PrimitiveFunc)]
ioStrictPrimitives :: [(String, String -> PrimitiveFunc)]
ioStrictPrimitives =
  [ (String
"return",          String -> PrimitiveFunc
return')
  , (String
"openInputFile",   IOMode -> String -> PrimitiveFunc
makePort IOMode
ReadMode)
  , (String
"openOutputFile",  IOMode -> String -> PrimitiveFunc
makePort IOMode
WriteMode)
  , (String
"closeInputPort",  String -> PrimitiveFunc
closePort)
  , (String
"closeOutputPort", String -> PrimitiveFunc
closePort)
  , (String
"readChar",        String -> PrimitiveFunc
readChar)
  , (String
"readLine",        String -> PrimitiveFunc
readLine)
  , (String
"writeChar",       String -> PrimitiveFunc
writeChar)
  , (String
"write",           String -> PrimitiveFunc
writeString)

  , (String
"readCharFromPort", String -> PrimitiveFunc
readCharFromPort)
  , (String
"readLineFromPort", String -> PrimitiveFunc
readLineFromPort)
  , (String
"writeCharToPort",  String -> PrimitiveFunc
writeCharToPort)
  , (String
"writeToPort",      String -> PrimitiveFunc
writeStringToPort)

  , (String
"isEof",     String -> PrimitiveFunc
isEOFStdin)
  , (String
"flush",     String -> PrimitiveFunc
flushStdout)
  , (String
"isEofPort", String -> PrimitiveFunc
isEOFPort)
  , (String
"flushPort", String -> PrimitiveFunc
flushPort)
  , (String
"readFile",  String -> PrimitiveFunc
readFile')

  , (String
"rand",       String -> PrimitiveFunc
randRange)
  , (String
"f.rand",     String -> PrimitiveFunc
randRangeDouble)

  , (String
"newIORef",   String -> PrimitiveFunc
newIORef')
  , (String
"writeIORef", String -> PrimitiveFunc
writeIORef')
  , (String
"readIORef",  String -> PrimitiveFunc
readIORef')

  , (String
"readProcess", String -> PrimitiveFunc
readProcess')
  ]

ioLazyPrimitives :: [(String, String -> LazyPrimitiveFunc)]
ioLazyPrimitives :: [(String, String -> LazyPrimitiveFunc)]
ioLazyPrimitives =
  [ (String
"io", String -> LazyPrimitiveFunc
io)
  ]

makeIO :: EvalM EgisonValue -> EgisonValue
makeIO :: EvalM EgisonValue -> EgisonValue
makeIO EvalM EgisonValue
m = EvalM WHNFData -> EgisonValue
IOFunc (EvalM WHNFData -> EgisonValue) -> EvalM WHNFData -> EgisonValue
forall a b. (a -> b) -> a -> b
$ (EgisonValue -> WHNFData) -> EvalM EgisonValue -> EvalM WHNFData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData)
-> (EgisonValue -> EgisonValue) -> EgisonValue -> WHNFData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [EgisonValue] -> EgisonValue
Tuple ([EgisonValue] -> EgisonValue)
-> (EgisonValue -> [EgisonValue]) -> EgisonValue -> EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EgisonValue
World EgisonValue -> [EgisonValue] -> [EgisonValue]
forall a. a -> [a] -> [a]
:) ([EgisonValue] -> [EgisonValue])
-> (EgisonValue -> [EgisonValue]) -> EgisonValue -> [EgisonValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EgisonValue -> [EgisonValue] -> [EgisonValue]
forall a. a -> [a] -> [a]
:[])) EvalM EgisonValue
m

makeIO' :: EvalM () -> EgisonValue
makeIO' :: EvalM () -> EgisonValue
makeIO' EvalM ()
m = EvalM WHNFData -> EgisonValue
IOFunc (EvalM WHNFData -> EgisonValue) -> EvalM WHNFData -> EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM ()
m EvalM () -> EvalM WHNFData -> EvalM WHNFData
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> WHNFData
Value (EgisonValue -> WHNFData) -> EgisonValue -> WHNFData
forall a b. (a -> b) -> a -> b
$ [EgisonValue] -> EgisonValue
Tuple [EgisonValue
World, [EgisonValue] -> EgisonValue
Tuple []])

return' :: String -> PrimitiveFunc
return' :: String -> PrimitiveFunc
return' = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return EgisonValue
val

makePort :: IOMode -> String -> PrimitiveFunc
makePort :: IOMode -> String -> PrimitiveFunc
makePort IOMode
mode = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Text
filename <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  Handle
port <- IO Handle -> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle
 -> StateT EvalState (ExceptT EgisonError RuntimeM) Handle)
-> IO Handle
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openFile (Text -> String
T.unpack Text
filename) IOMode
mode
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> EgisonValue
Port Handle
port)

closePort :: String -> PrimitiveFunc
closePort :: String -> PrimitiveFunc
closePort = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
port

writeChar :: String -> PrimitiveFunc
writeChar :: String -> PrimitiveFunc
writeChar = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Char
c <- EgisonValue -> EvalM Char
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Char -> IO ()
putChar Char
c

writeCharToPort :: String -> PrimitiveFunc
writeCharToPort :: String -> PrimitiveFunc
writeCharToPort = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val EgisonValue
val' -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  Char
c <- EgisonValue -> EvalM Char
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val'
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Handle -> Char -> IO ()
hPutChar Handle
port Char
c

writeString :: String -> PrimitiveFunc
writeString :: String -> PrimitiveFunc
writeString = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Text
s <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStr Text
s

writeStringToPort :: String -> PrimitiveFunc
writeStringToPort :: String -> PrimitiveFunc
writeStringToPort = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val EgisonValue
val' -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  Text
s <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val'
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
T.hPutStr Handle
port Text
s

flushStdout :: String -> PrimitiveFunc
flushStdout :: String -> PrimitiveFunc
flushStdout = EvalM EgisonValue -> String -> PrimitiveFunc
noArg (EvalM EgisonValue -> String -> PrimitiveFunc)
-> EvalM EgisonValue -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout

flushPort :: String -> PrimitiveFunc
flushPort :: String -> PrimitiveFunc
flushPort = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
port

readChar :: String -> PrimitiveFunc
readChar :: String -> PrimitiveFunc
readChar = EvalM EgisonValue -> String -> PrimitiveFunc
noArg (EvalM EgisonValue -> String -> PrimitiveFunc)
-> EvalM EgisonValue -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Char -> EgisonValue
Char (Char -> EgisonValue) -> IO Char -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Char
getChar)

readCharFromPort :: String -> PrimitiveFunc
readCharFromPort :: String -> PrimitiveFunc
readCharFromPort = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue
-> EvalM EgisonValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EvalM EgisonValue)
-> EvalM EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Char -> EgisonValue
Char (Char -> EgisonValue) -> IO Char -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Char
hGetChar Handle
port)

readLine :: String -> PrimitiveFunc
readLine :: String -> PrimitiveFunc
readLine = EvalM EgisonValue -> String -> PrimitiveFunc
noArg (EvalM EgisonValue -> String -> PrimitiveFunc)
-> EvalM EgisonValue -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Text -> EgisonValue) -> IO Text -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text
T.getLine)

readLineFromPort :: String -> PrimitiveFunc
readLineFromPort :: String -> PrimitiveFunc
readLineFromPort = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Text -> EgisonValue) -> IO Text -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Text
T.hGetLine Handle
port)

readFile' :: String -> PrimitiveFunc
readFile' :: String -> PrimitiveFunc
readFile' =  (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Text
filename <- EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Text -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Text -> EgisonValue) -> IO Text -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile (Text -> String
T.unpack Text
filename))

isEOFStdin :: String -> PrimitiveFunc
isEOFStdin :: String -> PrimitiveFunc
isEOFStdin = EvalM EgisonValue -> String -> PrimitiveFunc
noArg (EvalM EgisonValue -> String -> PrimitiveFunc)
-> EvalM EgisonValue -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> EgisonValue
Bool (Bool -> EgisonValue) -> IO Bool -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
isEOF)

isEOFPort :: String -> PrimitiveFunc
isEOFPort :: String -> PrimitiveFunc
isEOFPort = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg' ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val -> do
  Handle
port <- EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) Handle
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> EgisonValue
Bool (Bool -> EgisonValue) -> IO Bool -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO Bool
hIsEOF Handle
port)

randRange :: String -> PrimitiveFunc
randRange :: String -> PrimitiveFunc
randRange = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val EgisonValue
val' -> do
  Integer
i <- EgisonValue -> EvalM Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val :: EvalM Integer
  Integer
i' <- EgisonValue -> EvalM Integer
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val' :: EvalM Integer
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Integer -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Integer -> EgisonValue) -> IO Integer -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StdGen -> (Integer, StdGen)) -> IO Integer
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((Integer, Integer) -> StdGen -> (Integer, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Integer
i, Integer
i')))

randRangeDouble :: String -> PrimitiveFunc
randRangeDouble :: String -> PrimitiveFunc
randRangeDouble = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs' ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
val EgisonValue
val' -> do
  Double
i <- EgisonValue -> EvalM Double
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val :: EvalM Double
  Double
i' <- EgisonValue -> EvalM Double
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
val' :: EvalM Double
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Double -> EgisonValue
forall a. EgisonData a => a -> EgisonValue
toEgison (Double -> EgisonValue) -> IO Double -> IO EgisonValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StdGen -> (Double, StdGen)) -> IO Double
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((Double, Double) -> StdGen -> (Double, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Double
i, Double
i')))

newIORef' :: String -> PrimitiveFunc
newIORef' :: String -> PrimitiveFunc
newIORef' = EvalM EgisonValue -> String -> PrimitiveFunc
noArg (EvalM EgisonValue -> String -> PrimitiveFunc)
-> EvalM EgisonValue -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ do
  IORef EgisonValue
ref <- IO (IORef EgisonValue)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef EgisonValue)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef EgisonValue)
 -> StateT
      EvalState (ExceptT EgisonError RuntimeM) (IORef EgisonValue))
-> IO (IORef EgisonValue)
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef EgisonValue)
forall a b. (a -> b) -> a -> b
$ EgisonValue -> IO (IORef EgisonValue)
forall a. a -> IO (IORef a)
newIORef EgisonValue
Undefined
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (IORef EgisonValue -> EgisonValue
RefBox IORef EgisonValue
ref)

writeIORef' :: String -> PrimitiveFunc
writeIORef' :: String -> PrimitiveFunc
writeIORef' = (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
twoArgs ((EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
ref EgisonValue
val -> do
  IORef EgisonValue
ref' <- EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef EgisonValue)
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
ref
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM () -> EgisonValue
makeIO' (EvalM () -> EgisonValue) -> EvalM () -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO () -> EvalM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EvalM ()) -> IO () -> EvalM ()
forall a b. (a -> b) -> a -> b
$ IORef EgisonValue -> EgisonValue -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef EgisonValue
ref' EgisonValue
val

readIORef' :: String -> PrimitiveFunc
readIORef' :: String -> PrimitiveFunc
readIORef' = (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
oneArg ((EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc)
-> (EgisonValue -> EvalM EgisonValue) -> String -> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
ref -> do
  IORef EgisonValue
ref' <- EgisonValue
-> StateT
     EvalState (ExceptT EgisonError RuntimeM) (IORef EgisonValue)
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
ref
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ IO EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO EgisonValue -> EvalM EgisonValue)
-> IO EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ IORef EgisonValue -> IO EgisonValue
forall a. IORef a -> IO a
readIORef IORef EgisonValue
ref'

readProcess' :: String -> PrimitiveFunc
readProcess' :: String -> PrimitiveFunc
readProcess' = (EgisonValue -> EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String -> PrimitiveFunc
threeArgs' ((EgisonValue -> EgisonValue -> EgisonValue -> EvalM EgisonValue)
 -> String -> PrimitiveFunc)
-> (EgisonValue -> EgisonValue -> EgisonValue -> EvalM EgisonValue)
-> String
-> PrimitiveFunc
forall a b. (a -> b) -> a -> b
$ \EgisonValue
cmd EgisonValue
args EgisonValue
input -> do
  String
cmd'   <- Text -> String
T.unpack (Text -> String)
-> EvalM Text
-> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
cmd
  [String]
args'  <- (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String])
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Text]
-> StateT EvalState (ExceptT EgisonError RuntimeM) [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EgisonValue
-> StateT EvalState (ExceptT EgisonError RuntimeM) [Text]
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
args
  String
input' <- Text -> String
T.unpack (Text -> String)
-> EvalM Text
-> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EgisonValue -> EvalM Text
forall a. EgisonData a => EgisonValue -> EvalM a
fromEgison EgisonValue
input
  EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (EgisonValue -> EvalM EgisonValue)
-> EgisonValue -> EvalM EgisonValue
forall a b. (a -> b) -> a -> b
$ EvalM EgisonValue -> EgisonValue
makeIO (EvalM EgisonValue -> EgisonValue)
-> EvalM EgisonValue -> EgisonValue
forall a b. (a -> b) -> a -> b
$ do
    String
outputStr <- IO String -> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String
 -> StateT EvalState (ExceptT EgisonError RuntimeM) String)
-> IO String
-> StateT EvalState (ExceptT EgisonError RuntimeM) String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO String
readProcess String
cmd' [String]
args' String
input'
    EgisonValue -> EvalM EgisonValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EgisonValue
String (String -> Text
T.pack String
outputStr))

io :: String -> LazyPrimitiveFunc
io :: String -> LazyPrimitiveFunc
io = (WHNFData -> EvalM WHNFData) -> String -> LazyPrimitiveFunc
lazyOneArg WHNFData -> EvalM WHNFData
io'
  where
    io' :: WHNFData -> EvalM WHNFData
io' (Value (IOFunc EvalM WHNFData
m)) = do
      EgisonValue
val <- EvalM WHNFData
m EvalM WHNFData
-> (WHNFData -> EvalM EgisonValue) -> EvalM EgisonValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WHNFData -> EvalM EgisonValue
evalWHNF
      case EgisonValue
val of
        Tuple [EgisonValue
_, EgisonValue
val'] -> WHNFData -> EvalM WHNFData
forall (m :: * -> *) a. Monad m => a -> m a
return (WHNFData -> EvalM WHNFData) -> WHNFData -> EvalM WHNFData
forall a b. (a -> b) -> a -> b
$ EgisonValue -> WHNFData
Value EgisonValue
val'
        EgisonValue
_               -> (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"io" (EgisonValue -> WHNFData
Value EgisonValue
val))
    io' WHNFData
whnf = (CallStack -> EgisonError) -> EvalM WHNFData
forall a. (CallStack -> EgisonError) -> EvalM a
throwErrorWithTrace (String -> WHNFData -> CallStack -> EgisonError
TypeMismatch String
"io" WHNFData
whnf)