1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
{-# LANGUAGE CPP #-}
module Data.Streaming.FilesystemSpec (spec) where
import Test.Hspec
import Data.Streaming.Filesystem
import Control.Exception (bracket)
import Data.List (sort)
#if !WINDOWS
import System.Posix.Files (removeLink, createSymbolicLink, createNamedPipe)
import Control.Exception (try, IOException)
#endif
spec :: Spec
spec = describe "Data.Streaming.Filesystem" $ do
it "dirstream" $ do
res <- bracket (openDirStream "test/filesystem") closeDirStream
$ \ds -> do
Just w <- readDirStream ds
Just x <- readDirStream ds
Just y <- readDirStream ds
Just z <- readDirStream ds
return $ sort [w, x, y, z]
res `shouldBe` ["bar.txt", "baz.txt", "bin", "foo.txt"]
describe "getFileType" $ do
it "file" $ getFileType "streaming-commons.cabal" >>= (`shouldBe` FTFile)
it "dir" $ getFileType "Data" >>= (`shouldBe` FTDirectory)
#if !WINDOWS
it "file sym" $ do
_ <- tryIO $ removeLink "tmp"
createSymbolicLink "streaming-commons.cabal" "tmp"
ft <- getFileType "tmp"
_ <- tryIO $ removeLink "tmp"
ft `shouldBe` FTFileSym
it "file sym" $ do
_ <- tryIO $ removeLink "tmp"
createSymbolicLink "Data" "tmp"
ft <- getFileType "tmp"
_ <- tryIO $ removeLink "tmp"
ft `shouldBe` FTDirectorySym
it "other" $ do
_ <- tryIO $ removeLink "tmp"
e <- tryIO $ createNamedPipe "tmp" 0
case e of
-- Creating named pipe might fail on some filesystems
Left _ -> return ()
Right _ -> do
ft <- getFileType "tmp"
_ <- tryIO $ removeLink "tmp"
ft `shouldBe` FTOther
it "recursive symlink is other" $ do
_ <- tryIO $ removeLink "tmp"
createSymbolicLink "tmp" "tmp"
ft <- getFileType "tmp"
_ <- tryIO $ removeLink "tmp"
ft `shouldBe` FTOther
it "dangling symlink is other" $ do
_ <- tryIO $ removeLink "tmp"
createSymbolicLink "doesnotexist" "tmp"
ft <- getFileType "tmp"
_ <- tryIO $ removeLink "tmp"
ft `shouldBe` FTOther
tryIO :: IO a -> IO (Either IOException a)
tryIO = try
#endif
|
