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
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Path.Gen where
import Data.Functor
import Prelude
import Path
import Path.Internal
import qualified System.FilePath as FilePath
import Data.GenValidity
import Data.List (isSuffixOf, isInfixOf)
import Data.Maybe (isJust, mapMaybe)
import Test.QuickCheck
instance Validity (Path Abs File) where
validate p@(Path fp) =
mconcat
[ validateCommon p,
validateAbs p,
validateFile p,
declare "The path can be identically parsed as an absolute file path." $
parseAbsFile fp == Just p
]
instance Validity (Path Rel File) where
validate p@(Path fp) =
mconcat
[ validateCommon p,
validateRel p,
validateFile p,
declare "The path can be identically parsed as a relative file path." $
parseRelFile fp == Just p
]
instance Validity (Path Abs Dir) where
validate p@(Path fp) =
mconcat
[ validateCommon p,
validateAbs p,
validateDirectory p,
declare "The path can be identically parsed as an absolute directory path." $
parseAbsDir fp == Just p
]
instance Validity (Path Rel Dir) where
validate p@(Path fp) =
mconcat
[ validateCommon p,
validateRel p,
validateDirectory p,
declare "The path can be identically parsed as a relative directory path if it's not empty." $
parseRelDir fp == Just p || fp == ""
]
instance Validity (SomeBase Dir)
instance Validity (SomeBase File)
validateCommon :: Path b t -> Validation
validateCommon (Path fp) = mconcat
[ declare "System.FilePath considers the path valid if it's not empty." $ FilePath.isValid fp || fp == ""
, declare "The path does not contain a '..' path component." $ not (hasParentDir fp)
]
validateDirectory :: Path b Dir -> Validation
validateDirectory (Path fp) = mconcat
[ declare "The path has a trailing path separator if it's not empty." $ FilePath.hasTrailingPathSeparator fp || fp == ""
]
validateFile :: Path b File -> Validation
validateFile (Path fp) = mconcat
[ declare "The path has no trailing path separator." $ not (FilePath.hasTrailingPathSeparator fp)
, declare "The path does not equal \".\"" $ fp /= "."
, declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)
]
validateAbs :: Path Abs t -> Validation
validateAbs (Path fp) = mconcat
[ declare "The path is absolute." $ FilePath.isAbsolute fp
]
validateRel :: Path Rel t -> Validation
validateRel (Path fp) = mconcat
[ declare "The path is relative." $ FilePath.isRelative fp
]
instance GenValid (Path Abs File) where
genValid = (Path . ('/' :) <$> genFilePath) `suchThat` isValid
shrinkValid = filter isValid . shrinkValidWith parseAbsFile
instance GenValid (Path Abs Dir) where
genValid = (Path . ('/' :) . (++ "/") <$> genFilePath) `suchThat` isValid
shrinkValid = filter isValid . shrinkValidWith parseAbsDir
instance GenValid (Path Rel File) where
genValid = (Path <$> genFilePath) `suchThat` isValid
shrinkValid = filter isValid . shrinkValidWith parseRelFile
instance GenValid (Path Rel Dir) where
genValid = (Path . (++ "/") <$> genFilePath) `suchThat` isValid
shrinkValid = filter isValid . shrinkValidWith parseRelDir
instance GenValid (SomeBase Dir) where
genValid = genValidStructurallyWithoutExtraChecking
shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
instance GenValid (SomeBase File) where
genValid = genValidStructurallyWithoutExtraChecking
shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
-- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and
-- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to
-- be valid.
genFilePath :: Gen FilePath
genFilePath = listOf genPathyChar
genPathyChar :: Gen Char
genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")]
shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]
shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkValid f
|
