Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add Gen module and propery tests #31

Merged
merged 1 commit into from
Dec 21, 2017
Merged

Add Gen module and propery tests #31

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
58 changes: 58 additions & 0 deletions src/Data/Path/Pathy/Gen.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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]
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

https://github.com/purescript-contrib/purescript-strongcheck/blob/master/src/Test/StrongCheck/Data/AlphaNumString.purs#L10

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

But we have no dependency on that.



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]
32 changes: 31 additions & 1 deletion test/Main.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I guess this check is not the best, as I got this error at some point:

checking `parse <<< print` for `RelFile``
97/100 test(s) passed.
/Users/safareli/dev/slamdata/purescript-pathy/output/Control.Monad.Eff.Exception/foreign.js:29
    throw e;
    ^

Error: Test 40 (seed 846546249) failed: 
`parse (print path) != Just path` for path: `(((((((((currentDir </> dir "냫笼嬋ఱ护⿼") </> dir "ꘓၷ两뱖쌜") </> dir "沌뢑朿ガ茧") </> dir "ﹱ捴ኧ嵹") </> dir "횽") </> dir "⤋") </> dir "큛रꃙ") </> dir "/솛鼒") </> file "냫笼嬋ఱ护⿼")` which was re-parsed into `(Just (((((((((currentDir </> dir "냫笼嬋ఱ护⿼") </> dir "ꘓၷ两뱖쌜") </> dir "沌뢑朿ガ茧") </> dir "ﹱ捴ኧ嵹") </> dir "횽") </> dir "⤋") </> dir "큛रꃙ") </> dir "솛鼒") </> file "냫笼嬋ఱ护⿼"))`
	Printed path: "./냫笼嬋ఱ护⿼/ꘓၷ两뱖쌜/沌뢑朿ガ茧/ﹱ捴ኧ嵹/횽/⤋/큛रꃙ/솛鼒/냫笼嬋ఱ护⿼"
	Printed path': `(Just "./냫笼嬋ఱ护⿼/ꘓၷ两뱖쌜/沌뢑朿ガ茧/ﹱ捴ኧ嵹/횽/⤋/큛रꃙ/솛鼒/냫笼嬋ఱ护⿼")`

if we move show-ed values side by side difference becomes more clear (scroll to right end)

(((((((((currentDir </> dir "냫笼嬋ఱ护⿼") </> dir "ꘓၷ两뱖쌜") </> dir "沌뢑朿ガ茧") </> dir "ﹱ捴ኧ嵹") </> dir "횽") </> dir "⤋") </> dir "큛रꃙ") </> dir "/솛鼒") </> file "냫笼嬋ఱ护⿼")
(((((((((currentDir </> dir "냫笼嬋ఱ护⿼") </> dir "ꘓၷ两뱖쌜") </> dir "沌뢑朿ガ茧") </> dir "ﹱ捴ኧ嵹") </> dir "횽") </> dir "⤋") </> dir "큛रꃙ") </> dir "솛鼒") </> file "냫笼嬋ఱ护⿼")

The different part:

... </> dir "/솛鼒") </> file "냫笼嬋ఱ护⿼")
... </> dir "솛鼒") </> file "냫笼嬋ఱ护⿼")

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Used alpha numeric generator in resent amend so this issue is not going to occur

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"

Expand Down