From 4c6a0a00786ed4a4cdafbbd6af014364c2e25c28 Mon Sep 17 00:00:00 2001
From: Irakli Safareli <i.safareli@gmail.com>
Date: Wed, 20 Dec 2017 16:05:45 +0100
Subject: [PATCH] add Gen module and propery tests

---
 src/Data/Path/Pathy/Gen.purs | 58 ++++++++++++++++++++++++++++++++++++
 test/Main.purs               | 32 +++++++++++++++++++-
 2 files changed, 89 insertions(+), 1 deletion(-)
 create mode 100644 src/Data/Path/Pathy/Gen.purs

diff --git a/src/Data/Path/Pathy/Gen.purs b/src/Data/Path/Pathy/Gen.purs
new file mode 100644
index 0000000..98e7c57
--- /dev/null
+++ b/src/Data/Path/Pathy/Gen.purs
@@ -0,0 +1,58 @@
+module Data.Path.Pathy.Gen
+  ( genAbsDirPath
+  , genAbsFilePath
+  , genAbsAnyPath
+  , genRelDirPath
+  , genRelFilePath
+  , genRelAnyPath
+  )where
+
+import Prelude
+
+import Control.Monad.Gen (class MonadGen)
+import Control.Monad.Gen as Gen
+import Control.Monad.Rec.Class (class MonadRec)
+import Data.Char.Gen as CG
+import Data.Either (Either(..))
+import Data.Foldable (foldr)
+import Data.List as L
+import Data.NonEmpty ((:|))
+import Data.Path.Pathy (AbsPath, AbsFile, AbsDir, RelDir, RelFile, RelPath, Sandboxed, (</>))
+import Data.Path.Pathy as P
+import Data.String.Gen as SG
+
+genName ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m String
+genName = SG.genString $ Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha]
+
+
+genAbsDirPath :: forall m. MonadGen m => MonadRec m => m (AbsDir Sandboxed)
+genAbsDirPath = Gen.sized \size → do
+  newSize ← Gen.chooseInt 0 size
+  Gen.resize (const newSize) do
+    parts ∷ L.List String ← Gen.unfoldable genName
+    pure $ foldr (flip P.appendPath <<< P.dir) P.rootDir parts
+
+genAbsFilePath :: forall m. MonadGen m => MonadRec m => m (AbsFile Sandboxed)
+genAbsFilePath = do
+  dir ← genAbsDirPath
+  file ← genName
+  pure $ dir </> P.file file
+
+genAbsAnyPath :: forall m. MonadGen m => MonadRec m => m (AbsPath Sandboxed)
+genAbsAnyPath = Gen.oneOf $ (Left <$> genAbsDirPath) :| [Right <$> genAbsFilePath]
+
+genRelDirPath :: forall m. MonadGen m => MonadRec m => m (RelDir Sandboxed)
+genRelDirPath = Gen.sized \size → do
+  newSize ← Gen.chooseInt 0 size
+  Gen.resize (const newSize) do
+    parts ∷ L.List String ← Gen.unfoldable genName
+    pure $ foldr (flip P.appendPath <<< P.dir) P.currentDir parts
+
+genRelFilePath :: forall m. MonadGen m => MonadRec m => m (RelFile Sandboxed)
+genRelFilePath = do
+  dir ← genRelDirPath
+  file ← genName
+  pure $ dir </> P.file file
+
+genRelAnyPath :: forall m. MonadGen m => MonadRec m => m (RelPath Sandboxed)
+genRelAnyPath = Gen.oneOf $ (Left <$> genRelDirPath) :| [Right <$> genRelFilePath]
diff --git a/test/Main.purs b/test/Main.purs
index ca41e0e..8bdfa49 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -5,7 +5,8 @@ import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE, info, infoShow)
 import Data.Foldable (foldl)
 import Data.Maybe (Maybe(..), fromJust)
-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, (</>), (<..>), (<.>))
+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, (</>), (<..>), (<.>))
+import Data.Path.Pathy.Gen as PG
 import Data.String as Str
 import Partial.Unsafe (unsafePartial)
 import Test.QuickCheck as QC
@@ -39,8 +40,37 @@ instance arbitraryArbPath ∷ QC.Arbitrary ArbPath where
 pathPart ∷ Gen.Gen String
 pathPart = Gen.suchThat QC.arbitrary (not <<< Str.null)
 
+parsePrintCheck :: forall a b. Path a b Sandboxed -> Maybe (Path a b Unsandboxed) -> QC.Result
+parsePrintCheck input parsed =
+  if parsed == Just (unsandbox input)
+    then QC.Success
+    else QC.Failed
+      $ "`parse (print path) != Just path` for path: `" <> show input <> "` which was re-parsed into `" <> show parsed <> "`"
+      <> "\n\tPrinted path: " <> show (unsafePrintPath input)
+      <> "\n\tPrinted path': `" <> show (map unsafePrintPath parsed) <> "`"
+
+parsePrintAbsDirPath :: Gen.Gen QC.Result
+parsePrintAbsDirPath = PG.genAbsDirPath <#> \path ->
+  parsePrintCheck path (parseAbsDir $ unsafePrintPath path)
+
+parsePrintAbsFilePath :: Gen.Gen QC.Result
+parsePrintAbsFilePath = PG.genAbsFilePath <#> \path ->
+  parsePrintCheck path (parseAbsFile $ unsafePrintPath path)
+
+parsePrintRelDirPath :: Gen.Gen QC.Result
+parsePrintRelDirPath = PG.genRelDirPath <#> \path ->
+  parsePrintCheck path (parseRelDir $ unsafePrintPath path)
+
+parsePrintRelFilePath :: Gen.Gen QC.Result
+parsePrintRelFilePath = PG.genRelFilePath <#> \path ->
+  parsePrintCheck path (parseRelFile $ unsafePrintPath path)
+
 main :: QC.QC () Unit
 main = do
+  info "checking `parse <<< print` for `AbsDir``" *> QC.quickCheck parsePrintAbsDirPath
+  info "checking `parse <<< print` for `AbsFile``" *> QC.quickCheck parsePrintAbsFilePath
+  info "checking `parse <<< print` for `RelDir``" *> QC.quickCheck parsePrintRelDirPath
+  info "checking `parse <<< print` for `RelFile``" *> QC.quickCheck parsePrintRelFilePath
   -- Should not compile:
   -- test "(</>) - file in dir" (printPath (file "image.png" </> dir "foo")) "./image.png/foo"