{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

module CatEye.IOPrimitives where

import qualified UTF8Prelude as P
import qualified Control.Monad.Error as E

import MPSUTF8 hiding (none_of, apply)
import UTF8Prelude hiding ((.), (^), (>), (+), (*), any, not)

import Control.Monad.Error hiding (Error)
import System.IO.UTF8

import CatEye.Type
import CatEye.Constant
import CatEye.Parser
import CatEye.Env
import CatEye.Evaluator


io_primitives :: [([String], [Value] -> IOThrowsError Value)]
io_primitives =
  [ x  _apply             apply_proc
  , x  _open_input_file   (make_port ReadMode)
  , x  _open_output_file  (make_port WriteMode)
  , x  _close_input_port  close_port
  , x  _close_output_port close_port
  , x  _read              read_proc
  , x  _write             write_proc
  , x  _read_contents     read_contents
  , x  _read_all          read_all
  ]
  where x a b = (a, b)


apply_proc :: [Value] -> IOThrowsError Value
apply_proc [func, List args] = apply func args
apply_proc (func:args) = apply func args
apply_proc _ = not_match

make_port :: IOMode -> [Value] -> IOThrowsError Value
make_port mode [String filename] = openFile filename mode .liftIO ^ Port
make_port _ _ = not_match

close_port :: [Value] -> IOThrowsError Value
close_port [Port port] = liftIO $ hClose port >> (Bool True .return)
close_port _ = return $ Bool False

read_proc :: [Value] -> IOThrowsError Value
read_proc [] = read_proc [Port stdin]
read_proc [Port port] = (liftIO $ hGetLine port)
  >>= read_expr > lift_throws
read_proc _ = not_match

write_proc :: [Value] -> IOThrowsError Value
write_proc [x] = write_proc [x, Port stdout]
write_proc [x, Port port] = liftIO $ hPutStrLn port (x.show)
  >> Bool True .return
write_proc _ = not_match

read_contents :: [Value] -> IOThrowsError Value
read_contents [String filename] = readFile filename .liftIO ^ String
read_contents _ = not_match

read_all :: [Value] -> IOThrowsError Value
read_all [String filename] = load filename ^ List
read_all _ = not_match
