Skip to content

Commit

Permalink
Merge pull request #4 from purescript-contrib/exceptions
Browse files Browse the repository at this point in the history
Use new purescript-exceptions
  • Loading branch information
garyb committed Aug 9, 2014
2 parents bf46294 + 812550d commit 3de6a7e
Show file tree
Hide file tree
Showing 6 changed files with 144 additions and 156 deletions.
44 changes: 22 additions & 22 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -115,46 +115,46 @@

### Values

appendFile :: forall eff. FilePath -> Buffer -> Eff (fs :: FS | eff) (Either Error Unit)
appendFile :: forall eff. FilePath -> Buffer -> Eff (err :: Exception, fs :: FS | eff) Unit

appendTextFile :: forall eff. Encoding -> FilePath -> String -> Eff (fs :: FS | eff) (Either Error Unit)
appendTextFile :: forall eff. Encoding -> FilePath -> String -> Eff (err :: Exception, fs :: FS | eff) Unit

chmod :: forall eff. FilePath -> Number -> Eff (fs :: FS | eff) (Either Error Unit)
chmod :: forall eff. FilePath -> Number -> Eff (err :: Exception, fs :: FS | eff) Unit

chown :: forall eff. FilePath -> Number -> Number -> Eff (fs :: FS | eff) (Either Error Unit)
chown :: forall eff. FilePath -> Number -> Number -> Eff (err :: Exception, fs :: FS | eff) Unit

link :: forall eff. FilePath -> FilePath -> Eff (fs :: FS | eff) (Either Error Unit)
link :: forall eff. FilePath -> FilePath -> Eff (err :: Exception, fs :: FS | eff) Unit

mkdir :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error Unit)
mkdir :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) Unit

mkdir' :: forall eff. FilePath -> Number -> Eff (fs :: FS | eff) (Either Error Unit)
mkdir' :: forall eff. FilePath -> Number -> Eff (err :: Exception, fs :: FS | eff) Unit

readFile :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error Buffer)
readFile :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) Buffer

readTextFile :: forall eff. Encoding -> FilePath -> Eff (fs :: FS | eff) (Either Error String)
readTextFile :: forall eff. Encoding -> FilePath -> Eff (err :: Exception, fs :: FS | eff) String

readdir :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error [FilePath])
readdir :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) [FilePath]

readlink :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error FilePath)
readlink :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) FilePath

realpath :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error FilePath)
realpath :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) FilePath

realpath' :: forall eff cache. FilePath -> { | cache } -> Eff (fs :: FS | eff) (Either Error FilePath)
realpath' :: forall eff cache. FilePath -> { | cache } -> Eff (err :: Exception, fs :: FS | eff) FilePath

rename :: forall eff. FilePath -> FilePath -> Eff (fs :: FS | eff) (Either Error Unit)
rename :: forall eff. FilePath -> FilePath -> Eff (err :: Exception, fs :: FS | eff) Unit

rmdir :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error Unit)
rmdir :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) Unit

stat :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error Stats)
stat :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) Stats

symlink :: forall eff. FilePath -> FilePath -> SymlinkType -> Eff (fs :: FS | eff) (Either Error Unit)
symlink :: forall eff. FilePath -> FilePath -> SymlinkType -> Eff (err :: Exception, fs :: FS | eff) Unit

truncate :: forall eff. FilePath -> Number -> Eff (fs :: FS | eff) (Either Error Unit)
truncate :: forall eff. FilePath -> Number -> Eff (err :: Exception, fs :: FS | eff) Unit

unlink :: forall eff. FilePath -> Eff (fs :: FS | eff) (Either Error Unit)
unlink :: forall eff. FilePath -> Eff (err :: Exception, fs :: FS | eff) Unit

utimes :: forall eff. FilePath -> Date -> Date -> Eff (fs :: FS | eff) (Either Error Unit)
utimes :: forall eff. FilePath -> Date -> Date -> Eff (err :: Exception, fs :: FS | eff) Unit

writeFile :: forall eff. FilePath -> Buffer -> Eff (fs :: FS | eff) (Either Error Unit)
writeFile :: forall eff. FilePath -> Buffer -> Eff (err :: Exception, fs :: FS | eff) Unit

writeTextFile :: forall eff. Encoding -> FilePath -> String -> Eff (fs :: FS | eff) (Either Error Unit)
writeTextFile :: forall eff. Encoding -> FilePath -> String -> Eff (err :: Exception, fs :: FS | eff) Unit
4 changes: 2 additions & 2 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,7 @@
"purescript-foreign": ">=0.1.1",
"purescript-node-buffer": "*",
"purescript-node-path": ">=0.1.0",
"purescript-globals": ">=0.1.4",
"purescript-datetime": "*"
"purescript-datetime": "*",
"purescript-exceptions": "~0.2.0"
}
}
108 changes: 52 additions & 56 deletions examples/Test.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,90 +4,86 @@ import qualified Node.FS.Async as A
import qualified Node.FS.Sync as S
import Node.FS.Stats
import Control.Apply ((*>))
import Control.Monad.Eff.Exception
import Data.Either
import Debug.Trace
import Node.Encoding

trace' x = trace x *> return unit

main = do

file <- S.readTextFile UTF8 "examples\\Test.purs"
trace' "\n\nreadTextFile sync result:"
case file of
Right file' -> trace' $ file'
trace "\n\nreadTextFile sync result:"
trace $ file

err <- S.readTextFile UTF8 "examples\\does not exist"
case err of
Left err' -> trace' $ "Caught readTextFile error:\n" ++ show err'
catchException (\err -> do
trace $ "Caught readTextFile error:\n" ++ show err
return "") $ S.readTextFile UTF8 "examples\\does not exist"

S.rename "tmp\\Test.js" "tmp\\Test1.js"

S.truncate "tmp\\Test1.js" 1000

stats <- S.stat "tmp\\Test1.js"
case stats of
Right stats' -> do
trace "\n\nS.stat:"
trace' "isFile:"
trace' $ show $ isFile stats'
trace' "isDirectory:"
trace' $ show $ isDirectory stats'
trace' "isBlockDevice:"
trace' $ show $ isBlockDevice stats'
trace' "isCharacterDevice:"
trace' $ show $ isCharacterDevice stats'
trace' "isFIFO:"
trace' $ show $ isFIFO stats'
trace' "isSocket:"
trace' $ show $ isSocket stats'
trace' "isSymbolicLink:"
trace' $ show $ isSymbolicLink stats'
trace' "modifiedTime:"
trace' $ show $ modifiedTime stats'
trace' "accessedTime:"
trace' $ show $ accessedTime stats'
trace' "statusChangedTime:"
trace' $ show $ statusChangedTime stats'
trace "\n\nS.stat:"
trace "isFile:"
trace $ show $ isFile stats
trace "isDirectory:"
trace $ show $ isDirectory stats
trace "isBlockDevice:"
trace $ show $ isBlockDevice stats
trace "isCharacterDevice:"
trace $ show $ isCharacterDevice stats
trace "isFIFO:"
trace $ show $ isFIFO stats
trace "isSocket:"
trace $ show $ isSocket stats
trace "isSymbolicLink:"
trace $ show $ isSymbolicLink stats
trace "modifiedTime:"
trace $ show $ modifiedTime stats
trace "accessedTime:"
trace $ show $ accessedTime stats
trace "statusChangedTime:"
trace $ show $ statusChangedTime stats

A.rename "tmp\\Test1.js" "tmp\\Test.js" $ \x -> do
trace "\n\nrename result:"
either (trace' <<< show) (trace' <<< show) x
either (trace <<< show) (trace <<< show) x

A.truncate "tmp\\Test.js" 10 $ \x -> do
trace "\n\ntruncate result:"
either (trace' <<< show) (trace' <<< show) x
either (trace <<< show) (trace <<< show) x

A.readFile "examples\\Test.purs" $ \x -> do
trace "\n\nreadFile result:"
either (trace' <<< show) (trace' <<< show) x
either (trace <<< show) (trace <<< show) x

A.readTextFile UTF8 "examples\\Test.purs" $ \x -> do
trace "\n\nreadTextFile result:"
either (trace' <<< show) trace' x
either (trace <<< show) trace x

A.stat "examples\\Test.purs" $ \x -> do
trace "\n\nstat:"
case x of
Left err -> trace' $ "Error:" ++ show err
Left err -> trace $ "Error:" ++ show err
Right x' -> do
trace' "isFile:"
trace' $ show $ isFile x'
trace' "isDirectory:"
trace' $ show $ isDirectory x'
trace' "isBlockDevice:"
trace' $ show $ isBlockDevice x'
trace' "isCharacterDevice:"
trace' $ show $ isCharacterDevice x'
trace' "isFIFO:"
trace' $ show $ isFIFO x'
trace' "isSocket:"
trace' $ show $ isSocket x'
trace' "isSymbolicLink:"
trace' $ show $ isSymbolicLink x'
trace' "modifiedTime:"
trace' $ show $ modifiedTime x'
trace' "accessedTime:"
trace' $ show $ accessedTime x'
trace' "statusChangedTime:"
trace' $ show $ statusChangedTime x'
trace "isFile:"
trace $ show $ isFile x'
trace "isDirectory:"
trace $ show $ isDirectory x'
trace "isBlockDevice:"
trace $ show $ isBlockDevice x'
trace "isCharacterDevice:"
trace $ show $ isCharacterDevice x'
trace "isFIFO:"
trace $ show $ isFIFO x'
trace "isSocket:"
trace $ show $ isSocket x'
trace "isSymbolicLink:"
trace $ show $ isSymbolicLink x'
trace "modifiedTime:"
trace $ show $ modifiedTime x'
trace "accessedTime:"
trace $ show $ accessedTime x'
trace "statusChangedTime:"
trace $ show $ statusChangedTime x'
26 changes: 15 additions & 11 deletions src/Node/FS/Async.purs
Original file line number Diff line number Diff line change
Expand Up @@ -25,30 +25,34 @@ module Node.FS.Async
) where

import Control.Monad.Eff
import Control.Monad.Eff.Exception
import Data.Date
import Data.Either
import Data.Foreign
import Data.Function
import Data.Maybe
import Node.Buffer (Buffer(..))
import Node.Encoding
import Node.FS
import Node.FS.Stats
import Node.Path (FilePath())
import Global (Error(), error)

type JSCallback a = Fn2 Foreign a Unit
foreign import data Nullable :: * -> *

foreign import runCallbackEff
"function runCallbackEff (f) {\
\ return f(); \
\}" :: forall eff a. Eff eff a -> a
type JSCallback a = Fn2 (Nullable Error) a Unit

foreign import handleCallbackImpl
"function handleCallbackImpl(left, right, f) {\
\ return function(err, value) {\
\ if (err) f(left(err))();\
\ else f(right(value))();\
\ };\
\}" :: forall eff a. Fn3 (Error -> Either Error a)
(a -> Either Error a)
(Callback eff a)
(JSCallback a)

handleCallback :: forall eff a b. (Callback eff a) -> JSCallback a
handleCallback f = mkFn2 $ \err x -> runCallbackEff $ f case parseForeign read err of
Left err -> Left $ error $ "handleCallback failed: " ++ show err
Right (Just err') -> Left err'
Right Nothing -> Right x
handleCallback cb = runFn3 handleCallbackImpl Left Right cb

foreign import fs "var fs = require('fs');" ::
{ rename :: Fn3 FilePath FilePath (JSCallback Unit) Unit
Expand Down
6 changes: 3 additions & 3 deletions src/Node/FS/Stats.purs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ type StatsObj =

-- |
-- Stats wrapper to provide a usable interface to the underlying properties and methods.
--
--
data Stats = Stats StatsObj

foreign import showStatsObj
Expand All @@ -50,11 +50,11 @@ foreign import showStatsObj
instance showStats :: Show Stats where
show (Stats o) = "Stats " ++ showStatsObj o

foreign import statsMethod
foreign import statsMethod
"function statsMethod(m, s) {\
\ return s[m]();\
\}" :: Fn2 String StatsObj Boolean

isFile :: Stats -> Boolean
isFile (Stats s) = runFn2 statsMethod "isFile" s

Expand Down
Loading

0 comments on commit 3de6a7e

Please sign in to comment.