Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit e8f5581

Browse files
authoredDec 21, 2017
Merge pull request #31 from safareli/gen
Add Gen module and propery tests
2 parents 8712dde + 4c6a0a0 commit e8f5581

File tree

2 files changed

+89
-1
lines changed

2 files changed

+89
-1
lines changed
 

‎src/Data/Path/Pathy/Gen.purs

+58
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
module Data.Path.Pathy.Gen
2+
( genAbsDirPath
3+
, genAbsFilePath
4+
, genAbsAnyPath
5+
, genRelDirPath
6+
, genRelFilePath
7+
, genRelAnyPath
8+
)where
9+
10+
import Prelude
11+
12+
import Control.Monad.Gen (class MonadGen)
13+
import Control.Monad.Gen as Gen
14+
import Control.Monad.Rec.Class (class MonadRec)
15+
import Data.Char.Gen as CG
16+
import Data.Either (Either(..))
17+
import Data.Foldable (foldr)
18+
import Data.List as L
19+
import Data.NonEmpty ((:|))
20+
import Data.Path.Pathy (AbsPath, AbsFile, AbsDir, RelDir, RelFile, RelPath, Sandboxed, (</>))
21+
import Data.Path.Pathy as P
22+
import Data.String.Gen as SG
23+
24+
genName m. MonadGen m MonadRec m m String
25+
genName = SG.genString $ Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha]
26+
27+
28+
genAbsDirPath :: forall m. MonadGen m => MonadRec m => m (AbsDir Sandboxed)
29+
genAbsDirPath = Gen.sized \size → do
30+
newSize ← Gen.chooseInt 0 size
31+
Gen.resize (const newSize) do
32+
parts L.List StringGen.unfoldable genName
33+
pure $ foldr (flip P.appendPath <<< P.dir) P.rootDir parts
34+
35+
genAbsFilePath :: forall m. MonadGen m => MonadRec m => m (AbsFile Sandboxed)
36+
genAbsFilePath = do
37+
dir ← genAbsDirPath
38+
file ← genName
39+
pure $ dir </> P.file file
40+
41+
genAbsAnyPath :: forall m. MonadGen m => MonadRec m => m (AbsPath Sandboxed)
42+
genAbsAnyPath = Gen.oneOf $ (Left <$> genAbsDirPath) :| [Right <$> genAbsFilePath]
43+
44+
genRelDirPath :: forall m. MonadGen m => MonadRec m => m (RelDir Sandboxed)
45+
genRelDirPath = Gen.sized \size → do
46+
newSize ← Gen.chooseInt 0 size
47+
Gen.resize (const newSize) do
48+
parts L.List StringGen.unfoldable genName
49+
pure $ foldr (flip P.appendPath <<< P.dir) P.currentDir parts
50+
51+
genRelFilePath :: forall m. MonadGen m => MonadRec m => m (RelFile Sandboxed)
52+
genRelFilePath = do
53+
dir ← genRelDirPath
54+
file ← genName
55+
pure $ dir </> P.file file
56+
57+
genRelAnyPath :: forall m. MonadGen m => MonadRec m => m (RelPath Sandboxed)
58+
genRelAnyPath = Gen.oneOf $ (Left <$> genRelDirPath) :| [Right <$> genRelFilePath]

‎test/Main.purs

+31-1
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,8 @@ import Control.Monad.Eff (Eff)
55
import Control.Monad.Eff.Console (CONSOLE, info, infoShow)
66
import Data.Foldable (foldl)
77
import Data.Maybe (Maybe(..), fromJust)
8-
import Data.Path.Pathy (Path, Abs, Rel, Dir, File, Sandboxed, dir, rootDir, parseAbsDir, parseRelDir, currentDir, file, parseAbsFile, parseRelFile, parentDir', depth, sandbox, dropExtension, renameFile, canonicalize, unsandbox, unsafePrintPath, (</>), (<..>), (<.>))
8+
import Data.Path.Pathy (Path, Abs, Rel, Dir, File, Unsandboxed, Sandboxed, dir, rootDir, parseAbsDir, parseRelDir, currentDir, file, parseAbsFile, parseRelFile, parentDir', depth, sandbox, dropExtension, renameFile, canonicalize, unsandbox, unsafePrintPath, (</>), (<..>), (<.>))
9+
import Data.Path.Pathy.Gen as PG
910
import Data.String as Str
1011
import Partial.Unsafe (unsafePartial)
1112
import Test.QuickCheck as QC
@@ -39,8 +40,37 @@ instance arbitraryArbPath ∷ QC.Arbitrary ArbPath where
3940
pathPart Gen.Gen String
4041
pathPart = Gen.suchThat QC.arbitrary (not <<< Str.null)
4142

43+
parsePrintCheck :: forall a b. Path a b Sandboxed -> Maybe (Path a b Unsandboxed) -> QC.Result
44+
parsePrintCheck input parsed =
45+
if parsed == Just (unsandbox input)
46+
then QC.Success
47+
else QC.Failed
48+
$ "`parse (print path) != Just path` for path: `" <> show input <> "` which was re-parsed into `" <> show parsed <> "`"
49+
<> "\n\tPrinted path: " <> show (unsafePrintPath input)
50+
<> "\n\tPrinted path': `" <> show (map unsafePrintPath parsed) <> "`"
51+
52+
parsePrintAbsDirPath :: Gen.Gen QC.Result
53+
parsePrintAbsDirPath = PG.genAbsDirPath <#> \path ->
54+
parsePrintCheck path (parseAbsDir $ unsafePrintPath path)
55+
56+
parsePrintAbsFilePath :: Gen.Gen QC.Result
57+
parsePrintAbsFilePath = PG.genAbsFilePath <#> \path ->
58+
parsePrintCheck path (parseAbsFile $ unsafePrintPath path)
59+
60+
parsePrintRelDirPath :: Gen.Gen QC.Result
61+
parsePrintRelDirPath = PG.genRelDirPath <#> \path ->
62+
parsePrintCheck path (parseRelDir $ unsafePrintPath path)
63+
64+
parsePrintRelFilePath :: Gen.Gen QC.Result
65+
parsePrintRelFilePath = PG.genRelFilePath <#> \path ->
66+
parsePrintCheck path (parseRelFile $ unsafePrintPath path)
67+
4268
main :: QC.QC () Unit
4369
main = do
70+
info "checking `parse <<< print` for `AbsDir``" *> QC.quickCheck parsePrintAbsDirPath
71+
info "checking `parse <<< print` for `AbsFile``" *> QC.quickCheck parsePrintAbsFilePath
72+
info "checking `parse <<< print` for `RelDir``" *> QC.quickCheck parsePrintRelDirPath
73+
info "checking `parse <<< print` for `RelFile``" *> QC.quickCheck parsePrintRelFilePath
4474
-- Should not compile:
4575
-- test "(</>) - file in dir" (printPath (file "image.png" </> dir "foo")) "./image.png/foo"
4676

0 commit comments

Comments
 (0)
Please sign in to comment.