Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package ghc-path for openSUSE:Factory
checked in at 2022-02-11 23:09:26
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-path (Old)
and /work/SRC/openSUSE:Factory/.ghc-path.new.1956 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-path"
Fri Feb 11 23:09:26 2022 rev:21 rq:953509 version:0.9.2
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-path/ghc-path.changes 2021-06-23
17:38:32.888497586 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-path.new.1956/ghc-path.changes
2022-02-11 23:11:22.255286348 +0100
@@ -1,0 +2,12 @@
+Mon Dec 27 08:06:38 UTC 2021 - Peter Simons <psim...@suse.com>
+
+- Update path to version 0.9.2.
+ 0.9.2
+ * Data instances for Rel, Abs, File, and Dir.
+ * Bump hashable upper bound to <1.5.
+
+ 0.9.1
+ * Support for genvalidity >=1.0.0.0
+ * `mapSomeBase` and `prjSomeBase` for modifying or projecting SomeBase.
+
+-------------------------------------------------------------------
Old:
----
path-0.9.0.tar.gz
New:
----
path-0.9.2.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-path.spec ++++++
--- /var/tmp/diff_new_pack.h97hAA/_old 2022-02-11 23:11:22.783287875 +0100
+++ /var/tmp/diff_new_pack.h97hAA/_new 2022-02-11 23:11:22.799287921 +0100
@@ -19,7 +19,7 @@
%global pkg_name path
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.9.0
+Version: 0.9.2
Release: 0
Summary: Support for well-typed paths
License: BSD-3-Clause
++++++ path-0.9.0.tar.gz -> path-0.9.2.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/path-0.9.0/CHANGELOG new/path-0.9.2/CHANGELOG
--- old/path-0.9.0/CHANGELOG 2021-06-19 12:34:44.000000000 +0200
+++ new/path-0.9.2/CHANGELOG 2021-12-27 09:05:57.000000000 +0100
@@ -1,3 +1,11 @@
+0.9.2
+ * Data instances for Rel, Abs, File, and Dir.
+ * Bump hashable upper bound to <1.5.
+
+0.9.1
+ * Support for genvalidity >=1.0.0.0
+ * `mapSomeBase` and `prjSomeBase` for modifying or projecting SomeBase.
+
0.9.0
* Fix inconsistencies on different platforms:
[#166](https://github.com/commercialhaskell/path/issues/166)
* `replaceProperPrefix`
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/path-0.9.0/path.cabal new/path-0.9.2/path.cabal
--- old/path-0.9.0/path.cabal 2021-06-19 12:34:46.000000000 +0200
+++ new/path-0.9.2/path.cabal 2021-12-27 09:05:24.000000000 +0100
@@ -1,5 +1,5 @@
name: path
-version: 0.9.0
+version: 0.9.2
synopsis: Support for well-typed paths
description: Support for well-typed paths.
license: BSD3
@@ -35,7 +35,7 @@
, deepseq
, exceptions >= 0.4 && < 0.11
, filepath < 1.2.0.1 || >= 1.3
- , hashable >= 1.2 && < 1.4
+ , hashable >= 1.2 && < 1.5
, text
, template-haskell
if flag(dev)
@@ -81,7 +81,7 @@
, base >= 4.12 && < 5
, bytestring
, filepath < 1.2.0.1 || >= 1.3
- , genvalidity >= 0.8
+ , genvalidity >= 1.0
, genvalidity-property >= 0.4
, genvalidity-hspec >= 0.7
, hspec >= 2.0 && < 3
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/path-0.9.0/src/Path/Include.hs
new/path-0.9.2/src/Path/Include.hs
--- old/path-0.9.0/src/Path/Include.hs 2021-02-18 07:34:52.000000000 +0100
+++ new/path-0.9.2/src/Path/Include.hs 2021-12-27 09:04:07.000000000 +0100
@@ -18,12 +18,14 @@
-- we represent the notion of a relative root by "@.@". The relative root
denotes
-- the directory which contains the first component of a relative path.
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
module Path.PLATFORM_NAME
(-- * Types
@@ -61,6 +63,8 @@
,splitExtension
,fileExtension
,replaceExtension
+ ,mapSomeBase
+ ,prjSomeBase
-- * Parsing
,parseAbsDir
,parseRelDir
@@ -116,17 +120,17 @@
-- Types
-- | An absolute path.
-data Abs deriving (Typeable)
+data Abs deriving (Typeable, Data)
-- | A relative path; one without a root. Note that a @..@ path component to
-- represent the parent directory is not allowed by this library.
-data Rel deriving (Typeable)
+data Rel deriving (Typeable, Data)
-- | A file path.
-data File deriving (Typeable)
+data File deriving (Typeable, Data)
-- | A directory path.
-data Dir deriving (Typeable)
+data Dir deriving (Typeable, Data)
instance FromJSON (Path Abs File) where
parseJSON = parseJSONWith parseAbsFile
@@ -851,10 +855,27 @@
parseJSON = parseJSONWith parseSomeFile
{-# INLINE parseJSON #-}
+-- | Helper to project the contents out of a SomeBase object.
+--
+-- >>> prjSomeBase toFilePath (Abs [absfile|/foo/bar/cow.moo|]) ==
"/foo/bar/cow.moo"
+--
+prjSomeBase :: (forall b . Path b t -> a) -> SomeBase t -> a
+prjSomeBase f = \case
+ Abs a -> f a
+ Rel r -> f r
+
+-- | Helper to apply a function to the SomeBase object
+--
+-- >>> mapSomeBase parent (Abs [absfile|/foo/bar/cow.moo|]) == Abs
[absdir|"/foo/bar"|]
+--
+mapSomeBase :: (forall b . Path b t -> Path b t') -> SomeBase t -> SomeBase t'
+mapSomeBase f = \case
+ Abs a -> Abs $ f a
+ Rel r -> Rel $ f r
+
-- | Convert a valid path to a 'FilePath'.
fromSomeBase :: SomeBase t -> FilePath
-fromSomeBase (Abs p) = toFilePath p
-fromSomeBase (Rel p) = toFilePath p
+fromSomeBase = prjSomeBase toFilePath
-- | Convert a valid directory to a 'FilePath'.
fromSomeDir :: SomeBase Dir -> FilePath
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/path-0.9.0/test/Path/Gen.hs
new/path-0.9.2/test/Path/Gen.hs
--- old/path-0.9.0/test/Path/Gen.hs 2021-02-18 07:34:52.000000000 +0100
+++ new/path-0.9.2/test/Path/Gen.hs 2021-12-27 00:17:00.000000000 +0100
@@ -13,139 +13,106 @@
import qualified System.FilePath as FilePath
import Data.GenValidity
-import Data.List (isSuffixOf)
+import Data.List (isSuffixOf, isInfixOf)
import Data.Maybe (isJust, mapMaybe)
import Test.QuickCheck
--- | An absolute path to a file is valid if:
---
--- * Its path is an absolute path
--- * Its path has no trailing path separators
--- * Its path is valid according to 'System.FilePath's definition.
--- * Its path does not end in '/.'
--- * Its path is not '.'
--- * Its path does not contain '..'.
--- * Parsing the path and rendering it again results in the same path.
instance Validity (Path Abs File) where
validate p@(Path fp) =
mconcat
- [ declare "The path is absolute." $ FilePath.isAbsolute fp
- , declare "The path has no trailing path separator." $
- not (FilePath.hasTrailingPathSeparator fp)
- , declare "System.FilePath considers the path valid." $ FilePath.isValid
fp
- , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)
- , declare "The path does not equal \".\"" $ fp /= "."
- , declare "The path does not a parent directory." $ not (hasParentDir fp)
- , declare "The path can be identically parsed as an absolute file path."
$
- parseAbsFile fp == Just p
+ [ validateCommon p,
+ validateAbs p,
+ validateFile p,
+ declare "The path can be identically parsed as an absolute file path."
$
+ parseAbsFile fp == Just p
]
--- | A relative path to a file is valid if:
---
--- * Its path is a relative path
--- * Its path does not have a trailing path separator
--- * Its path is valid according to 'System.FilePath's definition.
--- * Its path is not '.'
--- * Its path is not empty
--- * Its path does not end in '/.'
--- * Its path is not '.'
--- * Its path does not contain '..'.
--- * Parsing the path and rendering it again results in the same path.
instance Validity (Path Rel File) where
validate p@(Path fp) =
mconcat
- [ declare "The path is relative." $ FilePath.isRelative fp
- , declare "The path has no trailing path separator." $
- not (FilePath.hasTrailingPathSeparator fp)
- , declare "System.FilePath considers the path valid." $ FilePath.isValid
fp
- , declare "The path does not equal \".\"" $ fp /= "."
- , declare "The path is not empty" $ not (null fp)
- , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)
- , declare "The path does not a parent directory." $ not (hasParentDir fp)
- , declare "The path can be identically parsed as a relative file path." $
- parseRelFile fp == Just p
+ [ validateCommon p,
+ validateRel p,
+ validateFile p,
+ declare "The path can be identically parsed as a relative file path." $
+ parseRelFile fp == Just p
]
--- | An absolute path to a directory is valid if:
---
--- * Its path is an absolute path
--- * Its path has a trailing path separator
--- * Its path is valid according to 'System.FilePath's definition.
--- * Its path does not contain '..'.
--- * Parsing the path and rendering it again results in the same path.
instance Validity (Path Abs Dir) where
validate p@(Path fp) =
mconcat
- [ declare "The path is absolute." $ FilePath.isAbsolute fp
- , declare "The path has a trailing path separator." $
FilePath.hasTrailingPathSeparator fp
- , declare "System.FilePath considers the path valid." $ FilePath.isValid
fp
- , declare "The path does not a parent directory." $ not (hasParentDir fp)
- , declare "The path can be identically parsed as an absolute directory
path." $
- parseAbsDir fp == Just p
+ [ validateCommon p,
+ validateAbs p,
+ validateDirectory p,
+ declare "The path can be identically parsed as an absolute directory
path." $
+ parseAbsDir fp == Just p
]
--- | A relative path to a directory is valid if:
---
--- * Its path is a relative path
--- * Its path has a trailing path separator
--- * Its path is valid according to 'System.FilePath's definition.
--- * Its path does not contain '..'.
--- * Parsing the path and rendering it again results in the same path.
instance Validity (Path Rel Dir) where
- validate (Path "") = valid
validate p@(Path fp) =
mconcat
- [ declare "The path is relative." $ FilePath.isRelative fp
- , declare "The path has a trailing path separator." $
FilePath.hasTrailingPathSeparator fp
- , declare "System.FilePath considers the path valid." $ FilePath.isValid
fp
- , declare "The path is not empty." $ not (null fp)
- , declare "The path does not a parent directory." $ not (hasParentDir fp)
- , declare "The path can be identically parsed as a relative directory
path." $
- parseRelDir fp == Just p
+ [ 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 GenUnchecked (Path Abs File) where
- genUnchecked = Path <$> genFilePath
+instance Validity (SomeBase Dir)
-instance GenValid (Path Abs File) where
- shrinkValid = shrinkValidWith parseAbsFile
-
-instance GenUnchecked (Path Rel File) where
- genUnchecked = Path <$> genFilePath
+instance Validity (SomeBase File)
-instance GenValid (Path Rel File) where
- shrinkValid = shrinkValidWith parseRelFile
+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 GenUnchecked (Path Abs Dir) where
- genUnchecked = Path <$> genFilePath
+instance GenValid (Path Abs File) where
+ genValid = (Path . ('/' :) <$> genFilePath) `suchThat` isValid
+ shrinkValid = filter isValid . shrinkValidWith parseAbsFile
instance GenValid (Path Abs Dir) where
- shrinkValid = shrinkValidWith parseAbsDir
+ genValid = (Path . ('/' :) . (++ "/") <$> genFilePath) `suchThat` isValid
+ shrinkValid = filter isValid . shrinkValidWith parseAbsDir
-instance GenUnchecked (Path Rel Dir) where
- genUnchecked = Path <$> genFilePath
+instance GenValid (Path Rel File) where
+ genValid = (Path <$> genFilePath) `suchThat` isValid
+ shrinkValid = filter isValid . shrinkValidWith parseRelFile
instance GenValid (Path Rel Dir) where
- shrinkValid = shrinkValidWith parseRelDir
+ genValid = (Path . (++ "/") <$> genFilePath) `suchThat` isValid
+ shrinkValid = filter isValid . shrinkValidWith parseRelDir
-data Extension =
- Extension String
- deriving (Show)
-
-instance Validity Extension where
- validate (Extension ext) =
- mconcat
- [ delve "Extension" ext
- , declare "It is possible to add the extension to \"./\"" $
- isJust $ addExtension ext $(mkRelFile "x")
- ]
-
-instance GenUnchecked Extension where
- genUnchecked = Extension <$> genFilePath
- shrinkUnchecked (Extension e) = Extension <$> shrinkUnchecked e
-
-instance GenValid Extension
+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
@@ -157,8 +124,4 @@
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 $
shrinkUnchecked f
-
-shrinkValidExtension :: Extension -> [Extension]
-shrinkValidExtension (Extension s) =
- map (Extension . drop 1 . toFilePath) $ mapMaybe (flip addExtension
$(mkRelFile "x")) (shrink s)
+shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $
shrinkValid f
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/path-0.9.0/test/ValidityTest.hs
new/path-0.9.2/test/ValidityTest.hs
--- old/path-0.9.0/test/ValidityTest.hs 2021-02-18 07:34:52.000000000 +0100
+++ new/path-0.9.2/test/ValidityTest.hs 2021-12-27 00:17:00.000000000 +0100
@@ -34,11 +34,17 @@
shrinkValidSpec @(Path Abs Dir)
genValidSpec @(Path Rel Dir)
shrinkValidSpec @(Path Rel Dir)
+ genValidSpec @(SomeBase Dir)
+ shrinkValidSpec @(SomeBase Dir)
+ genValidSpec @(SomeBase File)
+ shrinkValidSpec @(SomeBase File)
describe "Parsing" $ do
describe "Path Abs Dir" (parserSpec parseAbsDir)
describe "Path Rel Dir" (parserSpec parseRelDir)
describe "Path Abs File" (parserSpec parseAbsFile)
describe "Path Rel File" (parserSpec parseRelFile)
+ describe "SomeBase Dir" (parserSpec parseSomeDir)
+ describe "SomeBase file" (parserSpec parseSomeFile)
describe "Operations" $ do
describe "(</>)" operationAppend
describe "stripProperPrefix" operationStripDir
@@ -51,30 +57,49 @@
-- | The 'filename' operation.
operationFilename :: Spec
operationFilename = do
- forAllDirs "filename parent </> $(mkRelFile filename)) == filename
$(mkRelFile filename)" $ \parent ->
+ forAllDirs "filename (parent </> $(mkRelFile filename)) == filename
$(mkRelFile filename)" $ \parent ->
forAllValid $ \file -> filename (parent </> file) `shouldBe` filename file
+ forSomeDirs "filename (some:parent </> $(mkRelFile filename)) == filename
$(mkRelFile filename)" $ \someParent ->
+ forAllValid $ \file ->
+ prjSomeBase filename (mapSomeBase (</> file) someParent) `shouldBe`
filename file
it "produces a valid path on when passed a valid absolute path" $ do
- producesValidsOnValids (filename :: Path Abs File -> Path Rel File)
+ producesValid (filename :: Path Abs File -> Path Rel File)
it "produces a valid path on when passed a valid relative path" $ do
- producesValidsOnValids (filename :: Path Rel File -> Path Rel File)
+ producesValid (filename :: Path Rel File -> Path Rel File)
+ it "produces a valid filename when passed some valid base path" $
+ producesValid (prjSomeBase filename :: SomeBase File -> Path Rel File)
-- | The 'dirname' operation.
operationDirname :: Spec
operationDirname = do
forAllDirs "dirname parent </> $(mkRelDir dirname)) == dirname $(mkRelDir
dirname)" $ \parent ->
forAllValid $ \dir -> if dir == Path [] then pure () else dirname (parent
</> dir) `shouldBe` dirname dir
+ forSomeDirs "dirname (some:parent </> $(mkRelDir dirname)) == dirname
$(mkRelDir dirname)" $ \someParent ->
+ forAllValid $ \dir -> if dir == Path []
+ then pure ()
+ else prjSomeBase dirname (mapSomeBase (</> dir)
someParent) `shouldBe` dirname dir
it "produces a valid path on when passed a valid absolute path" $ do
- producesValidsOnValids (dirname :: Path Abs Dir -> Path Rel Dir)
+ producesValid (dirname :: Path Abs Dir -> Path Rel Dir)
it "produces a valid path on when passed a valid relative path" $ do
- producesValidsOnValids (dirname :: Path Rel Dir -> Path Rel Dir)
+ producesValid (dirname :: Path Rel Dir -> Path Rel Dir)
+ it "produces a valid path when passed some valid longer path" $
+ producesValid (prjSomeBase dirname :: SomeBase Dir -> Path Rel Dir)
-- | The 'parent' operation.
operationParent :: Spec
operationParent = do
it "produces a valid path on when passed a valid file path" $ do
- producesValidsOnValids (parent :: Path Abs File -> Path Abs Dir)
+ producesValid (parent :: Path Abs File -> Path Abs Dir)
it "produces a valid path on when passed a valid directory path" $ do
- producesValidsOnValids (parent :: Path Abs Dir -> Path Abs Dir)
+ producesValid (parent :: Path Abs Dir -> Path Abs Dir)
+ it "produces a valid path on when passed a valid abs file path" $ do
+ producesValid (parent :: Path Abs File -> Path Abs Dir)
+ it "produces a valid path on when passed a valid rel file path" $ do
+ producesValid (parent :: Path Rel File -> Path Rel Dir)
+ it "produces a valid path on when passed a valid abs directory path" $ do
+ producesValid (parent :: Path Abs Dir -> Path Abs Dir)
+ it "produces a valid path on when passed a valid rel directory path" $ do
+ producesValid (parent :: Path Rel Dir -> Path Rel Dir)
-- | The 'isProperPrefixOf' operation.
operationIsParentOf :: Spec
@@ -92,42 +117,49 @@
then pure () -- TODO do we always need this condition?
else stripProperPrefix parent (parent </> child) `shouldBe` Just child
it "produces a valid path on when passed a valid absolute file paths" $ do
- producesValidsOnValids2
+ producesValid2
(stripProperPrefix :: Path Abs Dir -> Path Abs File -> Maybe (Path Rel
File))
it "produces a valid path on when passed a valid absolute directory paths" $
do
- producesValidsOnValids2
+ producesValid2
(stripProperPrefix :: Path Abs Dir -> Path Abs Dir -> Maybe (Path Rel
Dir))
it "produces a valid path on when passed a valid relative file paths" $ do
- producesValidsOnValids2
+ producesValid2
(stripProperPrefix :: Path Rel Dir -> Path Rel File -> Maybe (Path Rel
File))
it "produces a valid path on when passed a valid relative directory paths" $
do
- producesValidsOnValids2
+ producesValid2
(stripProperPrefix :: Path Rel Dir -> Path Rel Dir -> Maybe (Path Rel
Dir))
-- | The '</>' operation.
operationAppend :: Spec
operationAppend = do
it "produces a valid path on when creating valid absolute file paths" $ do
- producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel File -> Path
Abs File)
+ producesValid2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)
it "produces a valid path on when creating valid absolute directory paths" $
do
- producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs
Dir)
+ producesValid2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)
it "produces a valid path on when creating valid relative file paths" $ do
- producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel File -> Path
Rel File)
+ producesValid2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File)
it "produces a valid path on when creating valid relative directory paths" $
do
- producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel
Dir)
+ producesValid2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)
extensionsSpec :: Spec
extensionsSpec = do
+ let addExtGensValidFile p =
+ case addExtension p $(mkRelFile "x") of
+ Nothing -> True
+ Just _ ->
+ case parseRelFile p of
+ Nothing -> False
+ _ -> True
it "if addExtension a b succeeds then parseRelFile b succeeds - 1" $
forAll genFilePath addExtGensValidFile
- -- skew the generated path towards a valid extension by prefixing a "."
+ -- skew the generated path towards a valid extension by prefixing a "."
it "if addExtension a b succeeds then parseRelFile b succeeds - 2" $
forAll genFilePath $ addExtGensValidFile . ("." ++)
- forAllFiles
- "(toFilePath . fromJust . addExtension ext) file \
- \== toFilePath a ++ b" $ \file ->
- forAllValid $ \(Extension ext) ->
- (toFilePath . fromJust . addExtension ext) file `shouldBe` toFilePath
file ++ ext
+ forAllFiles "Adding an extension is like adding the extension to the end if
it succeeds" $ \file ->
+ forAllValid $ \ext ->
+ case addExtension ext file of
+ Nothing -> pure () -- Fine
+ Just p -> toFilePath p `shouldBe` toFilePath file ++ ext
forAllFiles "splitExtension output joins to result in the original file" $
\file ->
case splitExtension file of
Nothing -> pure ()
@@ -149,28 +181,24 @@
case splitExtension file of
Nothing -> pure ()
Just (f, ext) -> addExtension ext f `shouldBe` Just file
- forAllFiles "uncurry addExtension . swap >=> splitExtension == return" $
\file ->
- forAllValid $ \(Extension ext) ->
- (addExtension ext file >>= splitExtension) `shouldReturn` (file, ext)
+ forAllFiles "an extension that was added can be split off again" $ \file ->
+ forAllValid $ \ext ->
+ case addExtension ext file of
+ Nothing -> pure () -- Fine
+ Just p -> splitExtension p `shouldBe` Just (file, ext)
forAllFiles "fileExtension == (fmap snd) . splitExtension" $ \file ->
case splitExtension file of
Nothing -> pure ()
Just (_, ext) -> fileExtension file `shouldBe` Just ext
- forAllFiles "flip addExtension file >=> fileExtension == return" $ \file ->
- forAllValid $ \(Extension ext) ->
- (fileExtension . fromJust . addExtension ext) file `shouldReturn` ext
+ forAllFiles "an extension that was added is considered to be there" $ \file
->
+ forAllValid $ \ext ->
+ case addExtension ext file of
+ Nothing -> pure () -- Fine
+ Just p -> fileExtension p `shouldBe` Just ext
forAllFiles "(fileExtension >=> flip replaceExtension file) file == return
file" $ \file ->
case fileExtension file of
Nothing -> pure ()
Just ext -> replaceExtension ext file `shouldBe` Just file
- where
- addExtGensValidFile p =
- case addExtension p $(mkRelFile "x") of
- Nothing -> True
- Just _ ->
- case parseRelFile p of
- Nothing -> False
- _ -> True
forAllFiles :: Testable a => String -> (forall b. Path b File -> a) -> Spec
forAllFiles n func = do
@@ -182,6 +210,10 @@
it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(parent :: Path Abs Dir)
-> func parent
it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(parent :: Path Rel Dir)
-> func parent
+forSomeDirs :: Testable a => String -> (SomeBase Dir -> a) -> Spec
+forSomeDirs n func = do
+ it (unwords [n, "SomeBase Dir"]) $ forAllValid $ \(parent :: SomeBase Dir)
-> func parent
+
forAllParentsAndChildren ::
Testable a => String -> (forall b t. Path b Dir -> Path Rel t -> a) ->
Spec
forAllParentsAndChildren n func = do
@@ -208,7 +240,7 @@
parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec
parserSpec parser =
it "Produces valid paths when it succeeds" $
- forAllShrink genFilePath shrinkUnchecked $ \path ->
+ forAllShrink genFilePath shrinkValid $ \path ->
case parser path of
Nothing -> pure ()
Just p ->
