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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module TestUtil(
module TestUtil,
module Test.Tasty.QuickCheck,
module Data.List,
module Data.Maybe
) where
import Test.Tasty.QuickCheck hiding ((==>))
import Data.ByteString.Short (ShortByteString)
import Data.List
import Data.Maybe
import Control.Monad
import qualified System.FilePath.Windows as W
import qualified System.FilePath.Posix as P
#ifdef GHC_MAKE
import qualified System.OsPath.Windows.Internal as AFP_W
import qualified System.OsPath.Posix.Internal as AFP_P
#else
import qualified System.OsPath.Windows as AFP_W
import qualified System.OsPath.Posix as AFP_P
import System.OsPath.Types
#endif
import System.OsString.Internal.Types
import System.OsString.Encoding.Internal
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
import GHC.IO.Encoding.UTF8 ( mkUTF8 )
import GHC.IO.Encoding.Failure
infixr 0 ==>
(==>) :: Bool -> Bool -> Bool
a ==> b = not a || b
newtype QFilePathValidW = QFilePathValidW FilePath deriving Show
instance Arbitrary QFilePathValidW where
arbitrary = fmap (QFilePathValidW . W.makeValid) arbitraryFilePath
shrink (QFilePathValidW x) = shrinkValid QFilePathValidW W.makeValid x
newtype QFilePathValidP = QFilePathValidP FilePath deriving Show
instance Arbitrary QFilePathValidP where
arbitrary = fmap (QFilePathValidP . P.makeValid) arbitraryFilePath
shrink (QFilePathValidP x) = shrinkValid QFilePathValidP P.makeValid x
newtype QFilePath = QFilePath FilePath deriving Show
instance Arbitrary QFilePath where
arbitrary = fmap QFilePath arbitraryFilePath
shrink (QFilePath x) = shrinkValid QFilePath id x
-- | Generate an arbitrary FilePath use a few special (interesting) characters.
arbitraryFilePath :: Gen FilePath
arbitraryFilePath = sized $ \n -> do
k <- choose (0,n)
replicateM k $ elements "?./:\\a ;_"
-- | Shrink, but also apply a validity function. Try and make shorter, or use more
-- @a@ (since @a@ is pretty dull), but make sure you terminate even after valid.
shrinkValid :: (FilePath -> a) -> (FilePath -> FilePath) -> FilePath -> [a]
shrinkValid wrap valid o =
[ wrap y
| y <- map valid $ shrinkList (\x -> ['a' | x /= 'a']) o
, length y < length o || (length y == length o && countA y > countA o)]
where countA = length . filter (== 'a')
encodeUtf16LE :: String -> ShortByteString
encodeUtf16LE = either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)
encodeUtf8 :: String -> ShortByteString
encodeUtf8 = either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)
decodeUtf16LE :: ShortByteString -> String
decodeUtf16LE = either (error . show) id . decodeWithTE (mkUTF16le TransliterateCodingFailure)
decodeUtf8 :: ShortByteString -> String
decodeUtf8 = either (error . show) id . decodeWithTE (mkUTF8 TransliterateCodingFailure)
#ifdef GHC_MAKE
newtype QFilePathValidAFP_W = QFilePathValidAFP_W ShortByteString deriving Show
instance Arbitrary QFilePathValidAFP_W where
arbitrary = fmap (QFilePathValidAFP_W . AFP_W.makeValid . encodeUtf16LE) arbitraryFilePath
shrink (QFilePathValidAFP_W x) = shrinkValid (QFilePathValidAFP_W . encodeUtf16LE) (decodeUtf16LE . AFP_W.makeValid . encodeUtf16LE) (decodeUtf16LE x)
newtype QFilePathValidAFP_P = QFilePathValidAFP_P ShortByteString deriving Show
instance Arbitrary QFilePathValidAFP_P where
arbitrary = fmap (QFilePathValidAFP_P . AFP_P.makeValid . encodeUtf8) arbitraryFilePath
shrink (QFilePathValidAFP_P x) = shrinkValid (QFilePathValidAFP_P . encodeUtf8) (decodeUtf8 . AFP_P.makeValid . encodeUtf8) (decodeUtf8 x)
newtype QFilePathAFP_W = QFilePathAFP_W ShortByteString deriving Show
newtype QFilePathAFP_P = QFilePathAFP_P ShortByteString deriving Show
instance Arbitrary QFilePathAFP_W where
arbitrary = fmap (QFilePathAFP_W . encodeUtf16LE) arbitraryFilePath
shrink (QFilePathAFP_W x) = shrinkValid (QFilePathAFP_W . encodeUtf16LE) id (decodeUtf16LE x)
instance Arbitrary QFilePathAFP_P where
arbitrary = fmap (QFilePathAFP_P . encodeUtf8) arbitraryFilePath
shrink (QFilePathAFP_P x) = shrinkValid (QFilePathAFP_P . encodeUtf8) id (decodeUtf8 x)
newtype QFilePathsAFP_W = QFilePathsAFP_W [ShortByteString] deriving Show
newtype QFilePathsAFP_P = QFilePathsAFP_P [ShortByteString] deriving Show
instance Arbitrary QFilePathsAFP_W where
arbitrary = fmap (QFilePathsAFP_W . fmap encodeUtf16LE) (listOf arbitraryFilePath)
instance Arbitrary QFilePathsAFP_P where
arbitrary = fmap (QFilePathsAFP_P . fmap encodeUtf8) (listOf arbitraryFilePath)
#else
newtype QFilePathValidAFP_W = QFilePathValidAFP_W WindowsPath deriving Show
instance Arbitrary QFilePathValidAFP_W where
arbitrary = fmap (QFilePathValidAFP_W . AFP_W.makeValid . WS . encodeUtf16LE) arbitraryFilePath
shrink (QFilePathValidAFP_W x) = shrinkValid (QFilePathValidAFP_W . WS . encodeUtf16LE) (decodeUtf16LE . getWindowsString . AFP_W.makeValid . WS . encodeUtf16LE) (decodeUtf16LE . getWindowsString $ x)
newtype QFilePathValidAFP_P = QFilePathValidAFP_P PosixPath deriving Show
instance Arbitrary QFilePathValidAFP_P where
arbitrary = fmap (QFilePathValidAFP_P . AFP_P.makeValid . PS . encodeUtf8) arbitraryFilePath
shrink (QFilePathValidAFP_P x) = shrinkValid (QFilePathValidAFP_P . PS . encodeUtf8) (decodeUtf8 . getPosixString . AFP_P.makeValid . PS . encodeUtf8) (decodeUtf8 . getPosixString $ x)
newtype QFilePathAFP_W = QFilePathAFP_W WindowsPath deriving Show
newtype QFilePathAFP_P = QFilePathAFP_P PosixPath deriving Show
instance Arbitrary QFilePathAFP_W where
arbitrary = fmap (QFilePathAFP_W . WS . encodeUtf16LE) arbitraryFilePath
shrink (QFilePathAFP_W x) = shrinkValid (QFilePathAFP_W . WS . encodeUtf16LE) id (decodeUtf16LE . getWindowsString $ x)
instance Arbitrary QFilePathAFP_P where
arbitrary = fmap (QFilePathAFP_P . PS . encodeUtf8) arbitraryFilePath
shrink (QFilePathAFP_P x) = shrinkValid (QFilePathAFP_P . PS . encodeUtf8) id (decodeUtf8 . getPosixString $ x)
newtype QFilePathsAFP_W = QFilePathsAFP_W [WindowsPath] deriving Show
newtype QFilePathsAFP_P = QFilePathsAFP_P [PosixPath] deriving Show
instance Arbitrary QFilePathsAFP_W where
arbitrary = fmap (QFilePathsAFP_W . fmap (WS . encodeUtf16LE)) (listOf arbitraryFilePath)
instance Arbitrary QFilePathsAFP_P where
arbitrary = fmap (QFilePathsAFP_P . fmap (PS . encodeUtf8)) (listOf arbitraryFilePath)
instance Arbitrary WindowsChar where
arbitrary = WW <$> arbitrary
instance Arbitrary PosixChar where
arbitrary = PW <$> arbitrary
#endif
|
