Skip to content

Commit 754a35c

Browse files
hdgarroodhdgarrood
committed
Get examples working again
1 parent 102229e commit 754a35c

File tree

2 files changed

+112
-94
lines changed

2 files changed

+112
-94
lines changed

‎examples/Test.purs‎

Lines changed: 108 additions & 92 deletions
Original file line numberDiff line numberDiff line change
@@ -1,106 +1,122 @@
1-
module Main where
1+
module Test where
22

3-
import qualified Node.FS.Async as A
4-
import qualified Node.FS.Sync as S
5-
import Node.FS.Stats
3+
import Prelude
4+
import Data.Maybe
5+
import Data.Either
66
import Control.Apply ((*>))
7+
import Control.Bind ((=<<))
8+
import Control.Monad.Eff
79
import Control.Monad.Eff.Exception
8-
import Data.Either
9-
import Debug.Trace
10+
import Control.Monad.Eff.Console (log)
1011
import Node.Encoding
11-
import Node.Buffer
12-
import Node.Path
13-
import Data.Maybe
12+
import qualified Node.Buffer as Buffer
13+
import qualified Node.Path as Path
14+
import Unsafe.Coerce
15+
16+
import Node.FS
17+
import Node.FS.Stats
18+
import qualified Node.FS.Async as A
19+
import qualified Node.FS.Sync as S
20+
21+
-- Cheat to allow `main` to type check. See also issue #5 in
22+
-- purescript-exceptions.
23+
catchException' ::
24+
forall a eff.
25+
(Error -> Eff (err :: EXCEPTION | eff) a)
26+
-> Eff (err :: EXCEPTION | eff) a
27+
-> Eff (err :: EXCEPTION | eff) a
28+
catchException' = unsafeCoerce catchException
1429

1530
main = do
31+
let fp = Path.concat
1632

17-
A.exists "examples\\Test.purs" $ \e ->
18-
trace $ "Test.purs exists? " ++ show e
19-
20-
file <- S.readTextFile UTF8 "examples\\Test.purs"
21-
trace "\n\nreadTextFile sync result:"
22-
trace $ file
23-
24-
catchException (\err -> do
25-
trace $ "Caught readTextFile error:\n" ++ show err
26-
return "") $ S.readTextFile UTF8 "examples\\does not exist"
27-
28-
S.rename "tmp\\Test.js" "tmp\\Test1.js"
29-
30-
S.truncate "tmp\\Test1.js" 1000
31-
32-
stats <- S.stat "tmp\\Test1.js"
33-
trace "\n\nS.stat:"
34-
trace "isFile:"
35-
trace $ show $ isFile stats
36-
trace "isDirectory:"
37-
trace $ show $ isDirectory stats
38-
trace "isBlockDevice:"
39-
trace $ show $ isBlockDevice stats
40-
trace "isCharacterDevice:"
41-
trace $ show $ isCharacterDevice stats
42-
trace "isFIFO:"
43-
trace $ show $ isFIFO stats
44-
trace "isSocket:"
45-
trace $ show $ isSocket stats
46-
trace "isSymbolicLink:"
47-
trace $ show $ isSymbolicLink stats
48-
trace "modifiedTime:"
49-
trace $ show $ modifiedTime stats
50-
trace "accessedTime:"
51-
trace $ show $ accessedTime stats
52-
trace "statusChangedTime:"
53-
trace $ show $ statusChangedTime stats
54-
55-
A.rename "tmp\\Test1.js" "tmp\\Test.js" $ \x -> do
56-
trace "\n\nrename result:"
57-
either (trace <<< show) (trace <<< show) x
58-
59-
A.truncate "tmp\\Test.js" 10 $ \x -> do
60-
trace "\n\ntruncate result:"
61-
either (trace <<< show) (trace <<< show) x
62-
63-
A.readFile "examples\\Test.purs" $ \x -> do
64-
trace "\n\nreadFile result:"
65-
either (trace <<< show) (trace <<< show) x
66-
67-
A.readTextFile UTF8 "examples\\Test.purs" $ \x -> do
68-
trace "\n\nreadTextFile result:"
69-
either (trace <<< show) trace x
70-
71-
A.stat "examples\\Test.purs" $ \x -> do
72-
trace "\n\nstat:"
33+
A.exists (fp ["examples", "Test.purs"]) $ \e ->
34+
log $ "Test.purs exists? " ++ show e
35+
36+
file <- S.readTextFile UTF8 (fp ["examples", "Test.purs"])
37+
log "\n\nreadTextFile sync result:"
38+
log $ file
39+
40+
catchException' (\err -> do
41+
log $ "Caught readTextFile error:\n" ++ show err
42+
return "") $ S.readTextFile UTF8 (fp ["examples", "does not exist"])
43+
44+
S.rename (fp ["tmp", "Test.js"]) (fp ["tmp", "Test1.js"])
45+
46+
S.truncate (fp ["tmp", "Test1.js"]) 1000
47+
48+
stats <- S.stat (fp ["tmp", "Test1.js"])
49+
log "\n\nS.stat:"
50+
log "isFile:"
51+
log $ show $ isFile stats
52+
log "isDirectory:"
53+
log $ show $ isDirectory stats
54+
log "isBlockDevice:"
55+
log $ show $ isBlockDevice stats
56+
log "isCharacterDevice:"
57+
log $ show $ isCharacterDevice stats
58+
log "isFIFO:"
59+
log $ show $ isFIFO stats
60+
log "isSocket:"
61+
log $ show $ isSocket stats
62+
log "isSymbolicLink:"
63+
log $ show $ isSymbolicLink stats
64+
log "modifiedTime:"
65+
log $ show $ modifiedTime stats
66+
log "accessedTime:"
67+
log $ show $ accessedTime stats
68+
log "statusChangedTime:"
69+
log $ show $ statusChangedTime stats
70+
71+
A.rename (fp ["tmp", "Test1.js"]) (fp ["tmp", "Test.js"]) $ \x -> do
72+
log "\n\nrename result:"
73+
either (log <<< show) (log <<< show) x
74+
75+
A.truncate (fp ["tmp", "Test.js"]) 10 $ \x -> do
76+
log "\n\ntruncate result:"
77+
either (log <<< show) (log <<< show) x
78+
79+
A.readFile (fp ["examples", "Test.purs"]) $ \x -> do
80+
log "\n\nreadFile result:"
81+
either (log <<< show) (log <<< show) x
82+
83+
A.readTextFile UTF8 (fp ["examples", "Test.purs"]) $ \x -> do
84+
log "\n\nreadTextFile result:"
85+
either (log <<< show) log x
86+
87+
A.stat (fp ["examples", "Test.purs"]) $ \x -> do
88+
log "\n\nstat:"
7389
case x of
74-
Left err -> trace $ "Error:" ++ show err
90+
Left err -> log $ "Error:" ++ show err
7591
Right x' -> do
76-
trace "isFile:"
77-
trace $ show $ isFile x'
78-
trace "isDirectory:"
79-
trace $ show $ isDirectory x'
80-
trace "isBlockDevice:"
81-
trace $ show $ isBlockDevice x'
82-
trace "isCharacterDevice:"
83-
trace $ show $ isCharacterDevice x'
84-
trace "isFIFO:"
85-
trace $ show $ isFIFO x'
86-
trace "isSocket:"
87-
trace $ show $ isSocket x'
88-
trace "isSymbolicLink:"
89-
trace $ show $ isSymbolicLink x'
90-
trace "modifiedTime:"
91-
trace $ show $ modifiedTime x'
92-
trace "accessedTime:"
93-
trace $ show $ accessedTime x'
94-
trace "statusChangedTime:"
95-
trace $ show $ statusChangedTime x'
96-
97-
let fdFile = join ["tmp", "FD.json"]
98-
fd0 <- S.fdOpen fdFile S.W (Just 420)
99-
let buf0 = fromString "[ 42 ]" UTF8
92+
log "isFile:"
93+
log $ show $ isFile x'
94+
log "isDirectory:"
95+
log $ show $ isDirectory x'
96+
log "isBlockDevice:"
97+
log $ show $ isBlockDevice x'
98+
log "isCharacterDevice:"
99+
log $ show $ isCharacterDevice x'
100+
log "isFIFO:"
101+
log $ show $ isFIFO x'
102+
log "isSocket:"
103+
log $ show $ isSocket x'
104+
log "isSymbolicLink:"
105+
log $ show $ isSymbolicLink x'
106+
log "modifiedTime:"
107+
log $ show $ modifiedTime x'
108+
log "accessedTime:"
109+
log $ show $ accessedTime x'
110+
log "statusChangedTime:"
111+
log $ show $ statusChangedTime x'
112+
113+
let fdFile = fp ["tmp", "FD.json"]
114+
fd0 <- S.fdOpen fdFile W (Just 420)
115+
buf0 <- Buffer.fromString "[ 42 ]" UTF8
100116
bytes0 <- S.fdAppend fd0 buf0
101117
S.fdFlush fd0
102118
S.fdClose fd0
103-
fd1 <- S.fdOpen fdFile S.R Nothing
104-
let buf1 = create (size buf0)
119+
fd1 <- S.fdOpen fdFile R Nothing
120+
buf1 <- Buffer.create =<< Buffer.size buf0
105121
bytes1 <- S.fdNext fd1 buf1
106122
S.fdClose fd1

‎examples/TestAsync.purs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,11 +14,13 @@ import qualified Node.Buffer as B
1414

1515
-- exercise the file descriptor based async IO functions
1616

17-
main :: forall eff . Eff (fs::FS,err::EXCEPTION,console::CONSOLE|eff) Unit
17+
main :: Eff _ Unit
1818
main = do
1919
let path1 = FP.concat( ["examples", "TestAsync.purs"] )
2020
path2 = FP.concat( ["examples", "TestAsync.purs.partial"] )
21-
buf = B.create 1000
21+
22+
buf <- B.create 1000
23+
2224
A.fdOpen path1 R Nothing $ \v -> case v of
2325
(Left err) -> log ("err:" ++ show err)
2426
(Right fd) -> do

0 commit comments

Comments
 (0)