@@ -5,14 +5,15 @@ import Prelude
5
5
import Control.Monad.Eff (Eff )
6
6
import Control.Monad.Eff.Console (CONSOLE , info )
7
7
import Control.Monad.Eff.Exception (EXCEPTION , throw )
8
- import Data.Maybe (Maybe (..))
8
+ import Data.Maybe (Maybe (..), maybe )
9
9
import Data.Newtype (un )
10
10
import Data.NonEmpty ((:|))
11
11
import Data.String as Str
12
12
import Data.String.NonEmpty (NonEmptyString )
13
13
import Data.String.NonEmpty as NES
14
14
import Data.Symbol (SProxy (..))
15
- import Pathy (class IsDirOrFile , class IsRelOrAbs , Abs , Dir , Name (..), Path , Rel , alterExtension , currentDir , debugPrintPath , dir , extension , file , joinName , parentOf , parseAbsDir , parseAbsFile , parseRelDir , parseRelFile , posixParser , posixPrinter , printPath , relativeTo , rename , rootDir , sandbox , sandboxAny , splitName , unsandbox , windowsPrinter , (<..>), (<.>), (</>))
15
+ import Data.Tuple (Tuple (..))
16
+ import Pathy (class IsDirOrFile , class IsRelOrAbs , Abs , Dir , Name (..), Path , Rel , alterExtension , currentDir , debugPrintPath , dir , extension , file , in' , joinName , parentOf , parseAbsDir , parseAbsFile , parseRelDir , parseRelFile , peel , posixParser , posixPrinter , printPath , relativeTo , rename , rootDir , sandbox , sandboxAny , splitName , unsandbox , windowsPrinter , (<..>), (<.>), (</>))
16
17
import Pathy.Gen as PG
17
18
import Pathy.Name (reflectName )
18
19
import Test.QuickCheck ((===))
@@ -95,6 +96,11 @@ checkJoinSplitNameId = do
95
96
n <- genAmbigiousName
96
97
pure $ joinName (splitName n) === id n
97
98
99
+ checkPeelIn :: forall b . IsDirOrFile b => Gen.Gen (Path Abs b ) -> Gen.Gen QC.Result
100
+ checkPeelIn gen = do
101
+ p <- gen
102
+ pure $ p === maybe p (\(Tuple r n) -> r </> in' n) (peel p)
103
+
98
104
checkRelative :: forall b . IsDirOrFile b => Gen.Gen (Path Abs b ) -> Gen.Gen QC.Result
99
105
checkRelative gen = do
100
106
p1 <- gen
@@ -120,6 +126,8 @@ main = do
120
126
info " checking `parse <<< print` for `RelFile`" *> QC .quickCheck parsePrintRelFilePath
121
127
info " checking `relativeTo` for `AbsDir`" *> QC .quickCheck (checkRelative PG .genAbsDirPath)
122
128
info " checking `relativeTo` for `AbsFile`" *> QC .quickCheck (checkRelative PG .genAbsFilePath)
129
+ info " checking `p === maybe p (\\ (Tuple r n) -> r </> in' n) (peel p)` for `AbsDir`" *> QC .quickCheck (checkPeelIn PG .genAbsDirPath)
130
+ info " checking `p === maybe p (\\ (Tuple r n) -> r </> in' n) (peel p)` for `AbsFile`" *> QC .quickCheck (checkPeelIn PG .genAbsFilePath)
123
131
info " checking `joinName <<< splitName === id`" *> QC .quickCheck checkJoinSplitNameId
124
132
info " checking `alterExtension id === id`" *> QC .quickCheck checkAlterExtensionId
125
133
0 commit comments