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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
-- |
-- Module: TestMain
-- Copyright: (c) Sergey Vinokurov 2023
-- License: Apache-2.0 (see LICENSE)
-- Maintainer: serg.foo@gmail.com
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module TestMain (main) where
import Control.Exception
import qualified Data.List as L
import System.OsPath
import System.Directory.OsPath.Streaming
import Test.Tasty
import Test.Tasty.HUnit
#ifndef mingw32_HOST_OS
import Numeric (showHex)
import System.Directory.OsPath
import System.OsString.Internal.Types (getOsString)
import System.Random
import qualified System.Posix.Files.PosixString as Posix
#endif
main :: IO ()
main = defaultMain tests
tests :: TestTree
tests = testGroup "Tests"
[ testCase "readDirStream" $ do
res <- bracket (openDirStream [osp|test/filesystem|]) closeDirStream $ \ds -> do
Just w <- readDirStream ds
Just x <- readDirStream ds
Just y <- readDirStream ds
Just z <- readDirStream ds
return $ L.sort [w, x, y, z]
res @?= [([osp|bar.txt|], File Regular), ([osp|baz.txt|], File Regular), ([osp|bin|], Directory Regular), ([osp|foo.txt|], File Regular)]
, testGroup "getFileType general"
[ testCase "file" $ do
getFileType [osp|directory-ospath-streaming.cabal|] >>= (@?= File Regular)
, testCase "directory" $ do
getFileType [osp|test|] >>= (@?= Directory Regular)
]
, testCase "getDirectoryContentsRecursive" $ do
res <- L.sort <$> getDirectoryContentsRecursive [osp|test/filesystem|]
res @?= [([osp|bar.txt|], File Regular), ([osp|baz.txt|], File Regular), ([osp|bin|], Directory Regular), ([osp|bin|] </> [osp|bin.txt|], File Regular), ([osp|foo.txt|], File Regular)]
#ifndef mingw32_HOST_OS
, withResource
(do
tmp <- getTemporaryDirectory >>= canonicalizePath
createFreshTempDir tmp [osp|test|])
removeDirectoryRecursive
$ \mkTmpDir -> testGroup "getFileType unix"
[ testCase "file symlink" $ do
tmp <- mkTmpDir
currDir <- getCurrentDirectory
let dest = tmp </> [osp|tmp1|]
Posix.createSymbolicLink
(getOsString (currDir </> [osp|directory-ospath-streaming.cabal|]))
(getOsString dest)
ft <- getFileType dest
ft @?= File Symlink
, testCase "directory symlink" $ do
tmp <- mkTmpDir
currDir <- getCurrentDirectory
let dest = tmp </> [osp|tmp2|]
Posix.createSymbolicLink
(getOsString (currDir </> [osp|src|]))
(getOsString dest)
ft <- getFileType dest
ft @?= Directory Symlink
, testCase "other" $ do
tmp <- mkTmpDir
let dest = tmp </> [osp|tmp3|]
res <- tryIO $ Posix.createNamedPipe (getOsString dest) 0
case res of
-- Creating named pipe might fail on some filesystems
Left _ -> pure ()
Right _ -> do
ft <- getFileType dest
ft @?= Other Regular
, testCase "recursive symlink is other" $ do
tmp <- mkTmpDir
let dest = tmp </> [osp|tmp4|]
Posix.createSymbolicLink
(getOsString dest)
(getOsString dest)
ft <- getFileType dest
ft @?= Other Symlink
, testCase "dangling symlink is other" $ do
tmp <- mkTmpDir
let dest = tmp </> [osp|tmp5|]
Posix.createSymbolicLink
(getOsString (tmp </> [osp|does-not-exist|]))
(getOsString dest)
ft <- getFileType dest
ft @?= Other Symlink
]
#endif
]
#ifndef mingw32_HOST_OS
tryIO :: IO a -> IO (Either IOException a)
tryIO = try
createFreshTempDir :: OsPath -> OsPath -> IO OsPath
createFreshTempDir dir prefix = go
where
go = do
(n :: Word) <- randomIO
n' <- encodeUtf (showHex n [])
let path = dir </> prefix <> [osp|-|] <> n'
exists <- doesDirectoryExist path
if exists
then go
else do
createDirectory path
pure path
#endif
|
