Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,8 @@
"purescript-foreign": "^0.7.0",
"purescript-node-buffer": "^0.1.0",
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, that reminds me, we should be using ^0.2.0 of node-buffer.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actually don't worry about this, I'll take care of it later.

"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",
Expand Down
48 changes: 48 additions & 0 deletions examples/TestAsync.purs
Original file line number Diff line number Diff line change
@@ -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)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This pattern of matching on the Left constructor every time should be abstracted away using a separate function, something like this:

  let takeRight = either (\err -> log (...))

  A.fdOpen path1 R Nothing $ takeRight $ \fd -> do
    log ("opened " ++ path1)
    A.fdNext fd buf $ takeRight $ \nbytes -> do
      ...

Also maybe throw an exception rather than just logging that an error happened? Then we could put this file into test/ and use it as a test.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was just meant to be a trivial demo to meet your request "Nothing fancy - I'm just thinking something like calling them once and checking nothing obviously wrong happens".

Are there plans to build a test suite for this library? The existing example file doesn't typecheck with the current compiler/libraries.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was just meant to be a trivial demo to meet your request

Ah yes of course, sorry, disregard that then. In that case let's leave this as-is for now.

I certainly agree with you that a test suite would be nice. The only reason we don't, as far as I'm aware, is that nobody has gotten around to it yet. I might have a go soon.

(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)
40 changes: 39 additions & 1 deletion src/Node/FS.purs
Original file line number Diff line number Diff line change
@@ -1,4 +1,15 @@
module Node.FS where
module Node.FS
( FS()
, FileDescriptor(..)
, FileFlags(..)
, FileMode(..)
, SymlinkType(..)
, BufferLength(..)
, BufferOffset(..)
, ByteCount(..)
, FilePosition(..)
, fileFlagsToNode
) where

import Prelude

Expand All @@ -7,6 +18,33 @@ 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

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
type BufferLength = Int
type BufferOffset = Int
type ByteCount = Int

-- |
-- Symlink varieties.
--
Expand Down
97 changes: 92 additions & 5 deletions src/Node/FS/Async.purs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,12 @@ module Node.FS.Async
, appendFile
, appendTextFile
, exists
, fdOpen
, fdRead
, fdNext
, fdWrite
, fdAppend
, fdClose
) where

import Prelude
Expand All @@ -34,17 +40,15 @@ import Data.Time
import Data.Either
import Data.Function
import Data.Maybe
import Data.Maybe.Unsafe(fromJust)
import Node.Buffer (Buffer(..))
import Data.Nullable
import Node.Buffer (Buffer(), size)
import Node.Encoding
import Node.FS
import Node.FS.Stats
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 ::
Expand All @@ -53,7 +57,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 ::
Expand All @@ -75,6 +79,10 @@ 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 :: 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
}

-- |
Expand Down Expand Up @@ -333,3 +341,82 @@ 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 <a
-- href="https://nodejs.org/api/fs.html#fs_fs_open_path_flags_mode_callback">Node
-- Documentation</a> for details.
--
fdOpen :: forall eff.
FilePath
-> FileFlags
-> Maybe FileMode
-> Callback eff FileDescriptor
-> Eff (fs :: FS | eff) Unit
fdOpen file flags mode cb = mkEff $ \_ -> runFn4 fs.open file (fileFlagsToNode flags) (toNullable mode) (handleCallback cb)

--|
-- Read from a file asynchronously. See <a
-- href="https://nodejs.org/api/fs.html#fs_fs_read_fd_buffer_offset_length_position_callback">Node
-- Documentation</a> for details.
--
fdRead :: forall eff.
FileDescriptor
-> Buffer
-> BufferOffset
-> BufferLength
-> Maybe FilePosition
-> Callback eff ByteCount
-> Eff (fs :: FS | eff) Unit
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
-- 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 <a
-- href="https://nodejs.org/api/fs.html#fs_fs_write_fd_buffer_offset_length_position_callback">Node
-- Documentation</a> for details.
--
fdWrite :: forall eff.
FileDescriptor
-> Buffer
-> BufferOffset
-> BufferLength
-> Maybe FilePosition
-> Callback eff ByteCount
-> Eff (fs :: FS | eff) Unit
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
-- 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 <a
-- href="https://nodejs.org/api/fs.html#fs_fs_close_fd_callback">Node
-- Documentation</a> for details.
--
fdClose :: forall eff.
FileDescriptor
-> Callback eff Unit
-> Eff (fs :: FS | eff) Unit
fdClose fd cb = mkEff $ \_ -> runFn2 fs.close fd (handleCallback cb)
40 changes: 4 additions & 36 deletions src/Node/FS/Sync.purs
Original file line number Diff line number Diff line change
Expand Up @@ -22,13 +22,6 @@ module Node.FS.Sync
, appendFile
, appendTextFile
, exists
, FileDescriptor(..)
, FileFlags(..)
, BufferLength(..)
, BufferOffset(..)
, ByteCount(..)
, FileMode(..)
, FilePosition(..)
, fdOpen
, fdRead
, fdNext
Expand All @@ -46,26 +39,14 @@ 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
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
Expand Down Expand Up @@ -333,28 +314,15 @@ exists file = return $ fs.existsSync file
-- href="http://nodejs.org/api/fs.html#fs_fs_opensync_path_flags_mode">Node
-- Documentation</a> for details.
--
fdOpen :: forall opts eff.
fdOpen :: forall eff.
FilePath
-> FileFlags
-> Maybe FileMode
-> 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 (fileFlagsToNode flags)
(Just m) -> mkEff $ \_ -> runFn3 createSync file (fileFlagsToNode flags) m

--|
-- Read to a file synchronously. See <a
Expand Down