@@ -36,6 +36,8 @@ import Data.Time.Clock.POSIX (getPOSIXTime)
3636import Data.Traversable (forM)
3737import Debug.Trace
3838import System.IO
39+import System.IO.Error
40+import System.IO.Unsafe
3941
4042#ifdef IDRIS_FFI
4143import Foreign.C.String
@@ -73,6 +75,27 @@ data ExecVal = EP NameType Name ExecVal
7375 | EHandle Handle
7476 | EStringBuf (IORef String)
7577
78+fileError :: IORef ExecVal
79+{-# NOINLINE fileError #-}
80+fileError = unsafePerformIO $ newIORef $ operationNotPermitted
81+
82+operationNotPermitted =
83+ ioWrap $ mkRaw $ EApp (EP (DCon 0 1 False)
84+ (sNS (sUN "GenericFileError") ["File", "Prelude"])
85+ EErased)
86+ (EConstant (I 1))
87+
88+namedFileError name =
89+ ioWrap $ mkRaw $ (EP (DCon 0 0 False)
90+ (sNS (sUN name) ["File", "Prelude"])
91+ EErased)
92+
93+mapError :: IOError -> ExecVal
94+mapError e
95+ | (isDoesNotExistError e) = namedFileError "FileNotFound"
96+ | (isPermissionError e) = namedFileError "PermissionDenied"
97+ | otherwise = operationNotPermitted
98+
7699mkRaw :: ExecVal -> ExecVal
77100mkRaw arg = EApp (EApp (EP (DCon 0 1 False) (sNS (sUN "MkRaw") ["FFI_C"]) EErased)
78101 EErased) arg
@@ -326,6 +349,10 @@ execForeign env ctxt arity ty fn xs onfail
326349 execApp env ctxt ch xs
327350 | Just (FFun "idris_time" _ _) <- foreignFromTT arity ty fn xs
328351 = do execIO $ fmap (ioWrap . EConstant . I . round) getPOSIXTime
352+ | Just (FFun "idris_showerror" _ _) <- foreignFromTT arity ty fn xs
353+ = do execIO $ return $ ioWrap $ EConstant $ Str "Operation not permitted"
354+ | Just (FFun "idris_mkFileError" _ _) <- foreignFromTT arity ty fn xs
355+ = do execIO $ readIORef fileError
329356 | Just (FFun "fileOpen" [(_,fileStr), (_,modeStr)] _) <- foreignFromTT arity ty fn xs
330357 = case (fileStr, modeStr) of
331358 (EConstant (Str f), EConstant (Str mode)) ->
@@ -343,8 +370,8 @@ execForeign env ctxt arity ty fn xs onfail
343370 hSetBinaryMode h' True
344371 return $ Right (ioWrap (EHandle h'), drop arity xs)
345372 Left err -> return $ Left err)
346− (\e -> let _ = ( e::SomeException)
347− in return $ Right (ioWrap (EPtr nullPtr), drop arity xs))
373+ (\e -> do writeIORef fileError $ mapError e
374+ return $ Right (ioWrap (EPtr nullPtr), drop arity xs))
348375 case f of
349376 Left err -> execFail . Msg $ err
350377 Right (res, rest) -> execApp env ctxt res rest