From 2baa25955f6c132998c6959d0941914f08eb32dc Mon Sep 17 00:00:00 2001 From: Tim Docker Date: Wed, 11 Nov 2015 08:27:10 +1100 Subject: [PATCH 1/4] Fix warnings --- src/Node/FS/Async.purs | 4 ++-- src/Node/FS/Sync.purs | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Node/FS/Async.purs b/src/Node/FS/Async.purs index a395b4b..475047c 100644 --- a/src/Node/FS/Async.purs +++ b/src/Node/FS/Async.purs @@ -35,7 +35,7 @@ import Data.Either import Data.Function import Data.Maybe import Data.Maybe.Unsafe(fromJust) -import Node.Buffer (Buffer(..)) +import Node.Buffer (Buffer()) import Node.Encoding import Node.FS import Node.FS.Stats @@ -53,7 +53,7 @@ foreign import handleCallbackImpl :: (Callback eff a) (JSCallback a) -handleCallback :: forall eff a b. (Callback eff a) -> JSCallback a +handleCallback :: forall eff a. (Callback eff a) -> JSCallback a handleCallback cb = runFn3 handleCallbackImpl Left Right cb foreign import fs :: diff --git a/src/Node/FS/Sync.purs b/src/Node/FS/Sync.purs index 422d51a..d8de4fc 100644 --- a/src/Node/FS/Sync.purs +++ b/src/Node/FS/Sync.purs @@ -46,7 +46,7 @@ import Data.Time import Data.Either import Data.Function import Data.Maybe (Maybe(..)) -import Node.Buffer (Buffer(..), size) +import Node.Buffer (Buffer(), size) import Node.Encoding import Node.FS import Node.FS.Stats @@ -333,7 +333,7 @@ exists file = return $ fs.existsSync file -- href="http://nodejs.org/api/fs.html#fs_fs_opensync_path_flags_mode">Node -- Documentation for details. -- -fdOpen :: forall opts eff. +fdOpen :: forall eff. FilePath -> FileFlags -> Maybe FileMode From f92f86c84c0b5e22039c0d2f5320a6679361b518 Mon Sep 17 00:00:00 2001 From: Tim Docker Date: Wed, 11 Nov 2015 17:24:39 +1100 Subject: [PATCH 2/4] Added async versions of incremental file operations --- examples/TestAsync.purs | 48 ++++++++++++++++++ src/Node/FS.purs | 38 +++++++++++++- src/Node/FS/Async.js | 16 +++++- src/Node/FS/Async.purs | 106 +++++++++++++++++++++++++++++++++++++++- src/Node/FS/Sync.purs | 36 +------------- 5 files changed, 207 insertions(+), 37 deletions(-) create mode 100644 examples/TestAsync.purs diff --git a/examples/TestAsync.purs b/examples/TestAsync.purs new file mode 100644 index 0000000..143f381 --- /dev/null +++ b/examples/TestAsync.purs @@ -0,0 +1,48 @@ +module Main where + +import Prelude +import Data.Either +import Data.Maybe +import Control.Monad.Eff +import Control.Monad.Eff.Console(log,CONSOLE()) +import Control.Monad.Eff.Exception + +import Node.FS +import qualified Node.FS.Async as A +import qualified Node.Path as FP +import qualified Node.Buffer as B + +-- exercise the file descriptor based async IO functions + +main :: forall eff . Eff (fs::FS,err::EXCEPTION,console::CONSOLE|eff) Unit +main = do + let path1 = FP.concat( ["examples", "TestAsync.purs"] ) + path2 = FP.concat( ["examples", "TestAsync.purs.partial"] ) + buf = B.create 1000 + A.fdOpen path1 R Nothing $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right fd) -> do + log ("opened " ++ path1) + A.fdNext fd buf $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right nbytes) -> do + log ("read " ++ show nbytes) + A.fdOpen path2 W Nothing $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right fd2) -> do + log ("opened " ++ path2) + A.fdAppend fd2 buf $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right nbytes) -> do + log ("wrote " ++ show nbytes) + A.fdClose fd2 $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right _) -> do + log ("closed " ++ path2) + A.fdClose fd $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right _) -> do + log ("closed " ++ path1) + A.unlink path2 $ \v -> case v of + (Left err) -> log ("err:" ++ show err) + (Right _) -> log ("unlinked " ++ path2) diff --git a/src/Node/FS.purs b/src/Node/FS.purs index bc936c4..5c371e1 100644 --- a/src/Node/FS.purs +++ b/src/Node/FS.purs @@ -1,4 +1,14 @@ -module Node.FS where +module Node.FS + ( FS() + , FileDescriptor(..) + , FileFlags(..) + , FileMode(..) + , SymlinkType(..) + , BufferLength(..) + , BufferOffset(..) + , ByteCount(..) + , FilePosition(..) + ) where import Prelude @@ -7,6 +17,32 @@ import Prelude -- foreign import data FS :: ! +foreign import data FileDescriptor :: * + +data FileFlags = R | R_PLUS | RS | RS_PLUS + | W | WX | W_PLUS | WX_PLUS + | A | AX | A_PLUS | AX_PLUS + +instance showFileFlags :: Show FileFlags where + show R = "r" + show R_PLUS = "r+" + show RS = "rs" + show RS_PLUS = "rs+" + show W = "w" + show WX = "wx" + show W_PLUS = "w+" + show WX_PLUS = "wx+" + show A = "a" + show AX = "ax" + show A_PLUS = "a+" + show AX_PLUS = "ax+" + +type FileMode = Int +type FilePosition = Int +type BufferLength = Int +type BufferOffset = Int +type ByteCount = Int + -- | -- Symlink varieties. -- diff --git a/src/Node/FS/Async.js b/src/Node/FS/Async.js index 792891f..598024a 100644 --- a/src/Node/FS/Async.js +++ b/src/Node/FS/Async.js @@ -4,7 +4,21 @@ // module Node.FS.Async -exports.fs = require('fs'); +var fs = require('fs'); +exports.fs = fs + +exports.create = fs.open; +exports.readSeq = fs.read; +exports.writeSeq = fs.write; + +exports.readSeq = function(fd, buffer, offset, length, callback) { + fs.read(fd, buffer, offset, length, null, callback); +} + +exports.writeSeq = function(fd, buffer, offset, length, callback) { + fs.write(fd, buffer, offset, length, null, callback); +} + exports.handleCallbackImpl = function (left, right, f) { return function (err, value) { diff --git a/src/Node/FS/Async.purs b/src/Node/FS/Async.purs index 475047c..f9d8d30 100644 --- a/src/Node/FS/Async.purs +++ b/src/Node/FS/Async.purs @@ -23,6 +23,12 @@ module Node.FS.Async , appendFile , appendTextFile , exists + , fdOpen + , fdRead + , fdNext + , fdWrite + , fdAppend + , fdClose ) where import Prelude @@ -35,7 +41,7 @@ import Data.Either import Data.Function import Data.Maybe import Data.Maybe.Unsafe(fromJust) -import Node.Buffer (Buffer()) +import Node.Buffer (Buffer(), size) import Node.Encoding import Node.FS import Node.FS.Stats @@ -75,8 +81,18 @@ foreign import fs :: , writeFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit , appendFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit , exists :: forall a. Fn2 FilePath (Boolean -> a) Unit + , open :: Fn3 FilePath String (JSCallback FileDescriptor) Unit + , read :: Fn6 FileDescriptor Buffer BufferOffset BufferLength FilePosition (JSCallback ByteCount) Unit + , write :: Fn6 FileDescriptor Buffer BufferOffset BufferLength FilePosition (JSCallback ByteCount) Unit + , close :: Fn2 FileDescriptor (JSCallback Unit) Unit } +foreign import create :: Fn4 FilePath String FileMode (JSCallback FileDescriptor) Unit + +foreign import writeSeq :: Fn5 FileDescriptor Buffer BufferOffset BufferLength (JSCallback ByteCount) Unit + +foreign import readSeq :: Fn5 FileDescriptor Buffer BufferOffset BufferLength (JSCallback ByteCount) Unit + -- | -- Type synonym for callback functions. -- @@ -333,3 +349,91 @@ exists :: forall eff. FilePath -> Eff (fs :: FS | eff) Unit exists file cb = mkEff $ \_ -> runFn2 fs.exists file $ \b -> runPure (unsafeInterleaveEff (cb b)) + + +{- Asynchronous File Descriptor Functions -} + +--| +-- Open a file asynchronously. See Node +-- Documentation for details. +-- +fdOpen :: forall eff. + FilePath + -> FileFlags + -> Maybe FileMode + -> Callback eff FileDescriptor + -> Eff (fs :: FS | eff) Unit +fdOpen file flags mode cb = + case mode of + Nothing -> mkEff $ \_ -> runFn3 fs.open file (show flags) (handleCallback cb) + (Just m) -> mkEff $ \_ -> runFn4 create file (show flags) m (handleCallback cb) + +--| +-- Read from a file asynchronously. See Node +-- Documentation for details. +-- +fdRead :: forall eff. + FileDescriptor + -> Buffer + -> BufferOffset + -> BufferLength + -> Maybe FilePosition + -> Callback eff ByteCount + -> Eff (fs :: FS | eff) Unit +fdRead fd buff off len Nothing cb = + mkEff $ \_ -> runFn5 readSeq fd buff off len (handleCallback cb) +fdRead fd buff off len (Just pos) cb = + mkEff $ \_ -> runFn6 fs.read fd buff off len pos (handleCallback cb) + +--| +-- Convienence function to fill the whole buffer from the current +-- file position. +-- +fdNext :: forall eff. + FileDescriptor + -> Buffer + -> Callback eff ByteCount + -> Eff (fs :: FS | eff) Unit +fdNext fd buff cb = fdRead fd buff 0 (size buff) Nothing cb + +--| +-- Write to a file asynchronously. See Node +-- Documentation for details. +-- +fdWrite :: forall eff. + FileDescriptor + -> Buffer + -> BufferOffset + -> BufferLength + -> Maybe FilePosition + -> Callback eff ByteCount + -> Eff (fs :: FS | eff) Unit +fdWrite fd buff off len Nothing cb = + mkEff $ \_ -> runFn5 writeSeq fd buff off len (handleCallback cb) +fdWrite fd buff off len (Just pos) cb = + mkEff $ \_ -> runFn6 fs.write fd buff off len pos (handleCallback cb) + +--| +-- Convienence function to append the whole buffer to the current +-- file position. +-- +fdAppend :: forall eff. + FileDescriptor + -> Buffer + -> Callback eff ByteCount + -> Eff (fs :: FS | eff) Unit +fdAppend fd buff cb = fdWrite fd buff 0 (size buff) Nothing cb + +--| +-- Close a file asynchronously. See Node +-- Documentation for details. +-- +fdClose :: forall eff. + FileDescriptor + -> Callback eff Unit + -> Eff (fs :: FS | eff) Unit +fdClose fd cb = mkEff $ \_ -> runFn2 fs.close fd (handleCallback cb) diff --git a/src/Node/FS/Sync.purs b/src/Node/FS/Sync.purs index d8de4fc..2da29eb 100644 --- a/src/Node/FS/Sync.purs +++ b/src/Node/FS/Sync.purs @@ -22,13 +22,6 @@ module Node.FS.Sync , appendFile , appendTextFile , exists - , FileDescriptor(..) - , FileFlags(..) - , BufferLength(..) - , BufferOffset(..) - , ByteCount(..) - , FileMode(..) - , FilePosition(..) , fdOpen , fdRead , fdNext @@ -54,18 +47,6 @@ import Node.Path (FilePath()) import Node.FS.Perms import Node.FS.Internal -foreign import data FileDescriptor :: * - -data FileFlags = R | R_PLUS | RS | RS_PLUS - | W | WX | W_PLUS | WX_PLUS - | A | AX | A_PLUS | AX_PLUS - -type BufferLength = Int -type BufferOffset = Int -type ByteCount = Int -type FileMode = Int -type FilePosition = Int - foreign import fs :: { renameSync :: Fn2 FilePath FilePath Unit , truncateSync :: Fn2 FilePath Int Unit @@ -340,21 +321,8 @@ fdOpen :: forall eff. -> Eff (err :: EXCEPTION, fs :: FS | eff) FileDescriptor fdOpen file flags mode = case mode of - Nothing -> mkEff $ \_ -> runFn2 fs.openSync file (toStr flags) - (Just m) -> mkEff $ \_ -> runFn3 createSync file (toStr flags) m - where - toStr R = "r" - toStr R_PLUS = "r+" - toStr RS = "rs" - toStr RS_PLUS = "rs+" - toStr W = "w" - toStr WX = "wx" - toStr W_PLUS = "w+" - toStr WX_PLUS = "wx+" - toStr A = "a" - toStr AX = "ax" - toStr A_PLUS = "a+" - toStr AX_PLUS = "ax+" + Nothing -> mkEff $ \_ -> runFn2 fs.openSync file (show flags) + (Just m) -> mkEff $ \_ -> runFn3 createSync file (show flags) m --| -- Read to a file synchronously. See Date: Thu, 12 Nov 2015 09:55:25 +1100 Subject: [PATCH 3/4] Use purescript-nullable to simplify async implementations --- bower.json | 3 ++- src/Node/FS/Async.js | 13 ------------- src/Node/FS/Async.purs | 31 +++++++------------------------ 3 files changed, 9 insertions(+), 38 deletions(-) diff --git a/bower.json b/bower.json index cc569f4..c89e52f 100644 --- a/bower.json +++ b/bower.json @@ -20,7 +20,8 @@ "purescript-foreign": "^0.7.0", "purescript-node-buffer": "^0.1.0", "purescript-node-path": "^0.4.0", - "purescript-unsafe-coerce": "^0.1.0" + "purescript-unsafe-coerce": "^0.1.0", + "purescript-nullable": "~0.2.1" }, "repository": { "type": "git", diff --git a/src/Node/FS/Async.js b/src/Node/FS/Async.js index 598024a..5dec7b0 100644 --- a/src/Node/FS/Async.js +++ b/src/Node/FS/Async.js @@ -7,19 +7,6 @@ var fs = require('fs'); exports.fs = fs -exports.create = fs.open; -exports.readSeq = fs.read; -exports.writeSeq = fs.write; - -exports.readSeq = function(fd, buffer, offset, length, callback) { - fs.read(fd, buffer, offset, length, null, callback); -} - -exports.writeSeq = function(fd, buffer, offset, length, callback) { - fs.write(fd, buffer, offset, length, null, callback); -} - - exports.handleCallbackImpl = function (left, right, f) { return function (err, value) { if (err) { diff --git a/src/Node/FS/Async.purs b/src/Node/FS/Async.purs index f9d8d30..9a0d4a2 100644 --- a/src/Node/FS/Async.purs +++ b/src/Node/FS/Async.purs @@ -40,7 +40,7 @@ import Data.Time import Data.Either import Data.Function import Data.Maybe -import Data.Maybe.Unsafe(fromJust) +import Data.Nullable import Node.Buffer (Buffer(), size) import Node.Encoding import Node.FS @@ -49,8 +49,6 @@ import Node.Path (FilePath()) import Node.FS.Perms import Node.FS.Internal -foreign import data Nullable :: * -> * - type JSCallback a = Fn2 (Nullable Error) a Unit foreign import handleCallbackImpl :: @@ -81,18 +79,12 @@ foreign import fs :: , writeFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit , appendFile :: forall a opts. Fn4 FilePath a { | opts } (JSCallback Unit) Unit , exists :: forall a. Fn2 FilePath (Boolean -> a) Unit - , open :: Fn3 FilePath String (JSCallback FileDescriptor) Unit - , read :: Fn6 FileDescriptor Buffer BufferOffset BufferLength FilePosition (JSCallback ByteCount) Unit - , write :: Fn6 FileDescriptor Buffer BufferOffset BufferLength FilePosition (JSCallback ByteCount) Unit + , open :: Fn4 FilePath String (Nullable FileMode) (JSCallback FileDescriptor) Unit + , read :: Fn6 FileDescriptor Buffer BufferOffset BufferLength (Nullable FilePosition) (JSCallback ByteCount) Unit + , write :: Fn6 FileDescriptor Buffer BufferOffset BufferLength (Nullable FilePosition) (JSCallback ByteCount) Unit , close :: Fn2 FileDescriptor (JSCallback Unit) Unit } -foreign import create :: Fn4 FilePath String FileMode (JSCallback FileDescriptor) Unit - -foreign import writeSeq :: Fn5 FileDescriptor Buffer BufferOffset BufferLength (JSCallback ByteCount) Unit - -foreign import readSeq :: Fn5 FileDescriptor Buffer BufferOffset BufferLength (JSCallback ByteCount) Unit - -- | -- Type synonym for callback functions. -- @@ -364,10 +356,7 @@ fdOpen :: forall eff. -> Maybe FileMode -> Callback eff FileDescriptor -> Eff (fs :: FS | eff) Unit -fdOpen file flags mode cb = - case mode of - Nothing -> mkEff $ \_ -> runFn3 fs.open file (show flags) (handleCallback cb) - (Just m) -> mkEff $ \_ -> runFn4 create file (show flags) m (handleCallback cb) +fdOpen file flags mode cb = mkEff $ \_ -> runFn4 fs.open file (show flags) (toNullable mode) (handleCallback cb) --| -- Read from a file asynchronously. See Maybe FilePosition -> Callback eff ByteCount -> Eff (fs :: FS | eff) Unit -fdRead fd buff off len Nothing cb = - mkEff $ \_ -> runFn5 readSeq fd buff off len (handleCallback cb) -fdRead fd buff off len (Just pos) cb = - mkEff $ \_ -> runFn6 fs.read fd buff off len pos (handleCallback cb) +fdRead fd buff off len pos cb = mkEff $ \_ -> runFn6 fs.read fd buff off len (toNullable pos) (handleCallback cb) --| -- Convienence function to fill the whole buffer from the current @@ -411,10 +397,7 @@ fdWrite :: forall eff. -> Maybe FilePosition -> Callback eff ByteCount -> Eff (fs :: FS | eff) Unit -fdWrite fd buff off len Nothing cb = - mkEff $ \_ -> runFn5 writeSeq fd buff off len (handleCallback cb) -fdWrite fd buff off len (Just pos) cb = - mkEff $ \_ -> runFn6 fs.write fd buff off len pos (handleCallback cb) +fdWrite fd buff off len pos cb = mkEff $ \_ -> runFn6 fs.write fd buff off len (toNullable pos) (handleCallback cb) --| -- Convienence function to append the whole buffer to the current From e845db5e5057be93d5467b04e09c4daa20c74e33 Mon Sep 17 00:00:00 2001 From: Tim Docker Date: Thu, 12 Nov 2015 11:19:51 +1100 Subject: [PATCH 4/4] Removed show instance for FileFlags --- src/Node/FS.purs | 28 +++++++++++++++------------- src/Node/FS/Async.js | 3 +-- src/Node/FS/Async.purs | 2 +- src/Node/FS/Sync.purs | 4 ++-- 4 files changed, 19 insertions(+), 18 deletions(-) diff --git a/src/Node/FS.purs b/src/Node/FS.purs index 5c371e1..e44eb02 100644 --- a/src/Node/FS.purs +++ b/src/Node/FS.purs @@ -8,6 +8,7 @@ module Node.FS , BufferOffset(..) , ByteCount(..) , FilePosition(..) + , fileFlagsToNode ) where import Prelude @@ -23,19 +24,20 @@ data FileFlags = R | R_PLUS | RS | RS_PLUS | W | WX | W_PLUS | WX_PLUS | A | AX | A_PLUS | AX_PLUS -instance showFileFlags :: Show FileFlags where - show R = "r" - show R_PLUS = "r+" - show RS = "rs" - show RS_PLUS = "rs+" - show W = "w" - show WX = "wx" - show W_PLUS = "w+" - show WX_PLUS = "wx+" - show A = "a" - show AX = "ax" - show A_PLUS = "a+" - show AX_PLUS = "ax+" +fileFlagsToNode :: FileFlags -> String +fileFlagsToNode ff = case ff of + R -> "r" + R_PLUS -> "r+" + RS -> "rs" + RS_PLUS -> "rs+" + W -> "w" + WX -> "wx" + W_PLUS -> "w+" + WX_PLUS -> "wx+" + A -> "a" + AX -> "ax" + A_PLUS -> "a+" + AX_PLUS -> "ax+" type FileMode = Int type FilePosition = Int diff --git a/src/Node/FS/Async.js b/src/Node/FS/Async.js index 5dec7b0..792891f 100644 --- a/src/Node/FS/Async.js +++ b/src/Node/FS/Async.js @@ -4,8 +4,7 @@ // module Node.FS.Async -var fs = require('fs'); -exports.fs = fs +exports.fs = require('fs'); exports.handleCallbackImpl = function (left, right, f) { return function (err, value) { diff --git a/src/Node/FS/Async.purs b/src/Node/FS/Async.purs index 9a0d4a2..4cda2cd 100644 --- a/src/Node/FS/Async.purs +++ b/src/Node/FS/Async.purs @@ -356,7 +356,7 @@ fdOpen :: forall eff. -> Maybe FileMode -> Callback eff FileDescriptor -> Eff (fs :: FS | eff) Unit -fdOpen file flags mode cb = mkEff $ \_ -> runFn4 fs.open file (show flags) (toNullable mode) (handleCallback cb) +fdOpen file flags mode cb = mkEff $ \_ -> runFn4 fs.open file (fileFlagsToNode flags) (toNullable mode) (handleCallback cb) --| -- Read from a file asynchronously. See Eff (err :: EXCEPTION, fs :: FS | eff) FileDescriptor fdOpen file flags mode = case mode of - Nothing -> mkEff $ \_ -> runFn2 fs.openSync file (show flags) - (Just m) -> mkEff $ \_ -> runFn3 createSync file (show flags) m + Nothing -> mkEff $ \_ -> runFn2 fs.openSync file (fileFlagsToNode flags) + (Just m) -> mkEff $ \_ -> runFn3 createSync file (fileFlagsToNode flags) m --| -- Read to a file synchronously. See