diff --git a/filepath.cabal b/filepath.cabal
index 3f9d0e302a92d60864a3d09a421fdd6ae29d8c35..1fe1da50383b3979103579b785bba97cd8120a2a 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -117,7 +117,8 @@ test-suite filepath-tests
, bytestring >=0.11.3.0
, filepath
, os-string >=2.0.1
- , QuickCheck >=2.7 && <2.15
+ , tasty
+ , tasty-quickcheck
default-language: Haskell2010
ghc-options: -Wall
@@ -133,6 +134,7 @@ test-suite filepath-equivalent-tests
Legacy.System.FilePath.Posix
Legacy.System.FilePath.Windows
TestUtil
+ Gen
build-depends:
, base
@@ -141,7 +143,6 @@ test-suite filepath-equivalent-tests
, generic-random
, generic-deriving
, os-string >=2.0.1
- , QuickCheck >=2.7 && <2.15
, tasty
, tasty-quickcheck
@@ -162,8 +163,9 @@ test-suite abstract-filepath
, deepseq
, filepath
, os-string >=2.0.1
- , QuickCheck >=2.7 && <2.15
, quickcheck-classes-base ^>=0.6.2
+ , tasty
+ , tasty-quickcheck
benchmark bench-filepath
default-language: Haskell2010
diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs
index 8365c930cd862b886d1ca1f0b2407b247a3778df..f238f10eb4283a9b29dc93d883b9d9f92ecb5dfb 100644
--- a/tests/TestUtil.hs
+++ b/tests/TestUtil.hs
@@ -4,12 +4,12 @@
module TestUtil(
module TestUtil,
- module Test.QuickCheck,
+ module Test.Tasty.QuickCheck,
module Data.List,
module Data.Maybe
) where
-import Test.QuickCheck hiding ((==>))
+import Test.Tasty.QuickCheck hiding ((==>))
import Data.ByteString.Short (ShortByteString)
import Data.List
import Data.Maybe
@@ -29,7 +29,6 @@ import System.OsString.Encoding.Internal
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
import GHC.IO.Encoding.UTF8 ( mkUTF8 )
import GHC.IO.Encoding.Failure
-import System.Environment
infixr 0 ==>
@@ -158,31 +157,3 @@ instance Arbitrary PosixChar where
arbitrary = PW <$> arbitrary
#endif
-runTests :: [(String, Property)] -> IO ()
-runTests tests = do
- args <- getArgs
- let count = case args of i:_ -> read i; _ -> 10000
- let testNum = case args of
- _:i:_
- | let num = read i
- , num < 0 -> drop (negate num) tests
- | let num = read i
- , num > 0 -> take num tests
- | otherwise -> []
- _ -> tests
- putStrLn $ "Testing with " ++ show count ++ " repetitions"
- let total' = length testNum
- let showOutput x = show x{output=""} ++ "\n" ++ output x
- bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do
- putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg
- res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
- case res of
- Success{} -> pure Nothing
- bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad)
- if null bad then
- putStrLn $ "Success, " ++ show total' ++ " tests passed"
- else do
- putStrLn $ show (length bad) ++ " FAILURES\n"
- forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) ->
- putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
- fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"
diff --git a/tests/abstract-filepath/Arbitrary.hs b/tests/abstract-filepath/Arbitrary.hs
index 7918eb16239c1a382a18e4470fb9b8e7aec32e39..5753523413c768e8e31b4da1f33252ae1574b05b 100644
--- a/tests/abstract-filepath/Arbitrary.hs
+++ b/tests/abstract-filepath/Arbitrary.hs
@@ -10,7 +10,7 @@ import qualified System.OsString.Posix as Posix
import qualified System.OsString.Windows as Windows
import Data.ByteString ( ByteString )
import qualified Data.ByteString as ByteString
-import Test.QuickCheck
+import Test.Tasty.QuickCheck
instance Arbitrary OsString where
diff --git a/tests/abstract-filepath/OsPathSpec.hs b/tests/abstract-filepath/OsPathSpec.hs
index 35bff2ee1bb203601d4b7f549824eac8b8496691..95b96423d8351cfa4b44390923ab9a73d25daf20 100644
--- a/tests/abstract-filepath/OsPathSpec.hs
+++ b/tests/abstract-filepath/OsPathSpec.hs
@@ -20,7 +20,6 @@ import System.OsString.Windows as WindowsS hiding (map)
import Control.Exception
import Data.ByteString ( ByteString )
import qualified Data.ByteString as BS
-import Test.QuickCheck
import qualified Test.QuickCheck.Classes.Base as QC
import GHC.IO.Encoding.UTF8 ( mkUTF8 )
import GHC.IO.Encoding.UTF16 ( mkUTF16le )
@@ -33,6 +32,8 @@ import qualified System.OsString.Data.ByteString.Short.Word16 as BS16
import qualified System.OsString.Data.ByteString.Short as SBS
import Data.Char ( ord )
import Data.Proxy ( Proxy(..) )
+import Test.Tasty
+import Test.Tasty.QuickCheck
import Arbitrary
@@ -42,211 +43,216 @@ fromRight _ (Right b) = b
fromRight b _ = b
-tests :: [(String, Property)]
-tests =
- [ ("OSP.encodeUtf . OSP.decodeUtf == id",
- property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str)
+tests :: TestTree
+tests = testGroup "Abstract filepath" [
+ testGroup "filepaths"
+ [ testProperties "OSP"
+ [ ("pack . unpack == id",
+ property $ \ws@(OsString _) ->
+ OSP.pack (OSP.unpack ws) === ws
+ ),
+ ("encodeUtf . decodeUtf == id",
+ property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str)
+ ],
+ testProperties "Windows"
+ [ ("pack . unpack == id (Windows)",
+ property $ \ws@(WindowsString _) ->
+ Windows.pack (Windows.unpack ws) === ws
+ )
+ , ("decodeUtf . encodeUtf == id",
+ property $ \(NonNullString str) -> (Windows.decodeUtf . fromJust . Windows.encodeUtf) str == Just str)
+ , ("encodeWith ucs2le . decodeWith ucs2le == id",
+ property $ \(padEven -> bs) -> (Windows.encodeWith ucs2le . (\(Right r) -> r) . Windows.decodeWith ucs2le . OS.WS . toShort) bs
+ === Right (OS.WS . toShort $ bs))
+ , ("decodeFS . encodeFS == id (Windows)",
+ property $ \(NonNullString str) -> ioProperty $ do
+ r1 <- Windows.encodeFS str
+ r2 <- try @SomeException $ Windows.decodeFS r1
+ r3 <- evaluate $ force $ first displayException r2
+ pure (r3 === Right str)
+ )
+ , ("fromPlatformString* functions are equivalent under ASCII",
+ property $ \(WindowsString . BS16.pack . map (fromIntegral . ord) . nonNullAsciiString -> str) -> ioProperty $ do
+ r1 <- Windows.decodeFS str
+ r2 <- Windows.decodeUtf str
+ (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) str
+ (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) str
+ (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) str
+ pure ( r1 === r2
+ .&&. r1 === r3
+ .&&. r1 === r4
+ .&&. r1 === r5
+ )
+ )
+ , ("toPlatformString* functions are equivalent under ASCII",
+ property $ \(NonNullAsciiString str) -> ioProperty $ do
+ r1 <- Windows.encodeFS str
+ r2 <- Windows.encodeUtf str
+ (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
+ (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
+ (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
+ pure ( r1 === r2
+ .&&. r1 === r3
+ .&&. r1 === r4
+ .&&. r1 === r5
+ )
+ )
+ , ("Unit test toPlatformString*",
+ property $ ioProperty $ do
+ let str = "ABcK_(ツ123_&**"
+ let expected = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
+ r1 <- Windows.encodeFS str
+ r2 <- Windows.encodeUtf str
+ (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
+ (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
+ (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
+ pure ( r1 === expected
+ .&&. r2 === expected
+ .&&. r3 === expected
+ .&&. r4 === expected
+ .&&. r5 === expected
+ )
+ )
+ , ("Unit test fromPlatformString*",
+ property $ ioProperty $ do
+ let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
+ let expected = "ABcK_(ツ123_&**"
+ r1 <- Windows.decodeFS bs
+ r2 <- Windows.decodeUtf bs
+ (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) bs
+ (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) bs
+ (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) bs
+ pure ( r1 === expected
+ .&&. r2 === expected
+ .&&. r3 === expected
+ .&&. r4 === expected
+ .&&. r5 === expected
+ )
+ )
+ ]
+ , testProperties "Posix"
+ [ ("decodeUtf . encodeUtf == id",
+ property $ \(NonNullString str) -> (Posix.decodeUtf . fromJust . Posix.encodeUtf) str == Just str)
+ , ("encodeWith ucs2le . decodeWith ucs2le == id (Posix)",
+ property $ \(padEven -> bs) -> (Posix.encodeWith ucs2le . (\(Right r) -> r) . Posix.decodeWith ucs2le . OS.PS . toShort) bs === Right (OS.PS . toShort $ bs))
+ , ("decodeFS . encodeFS == id",
+ property $ \(NonNullString str) -> ioProperty $ do
+ setFileSystemEncoding (mkUTF8 TransliterateCodingFailure)
+ r1 <- Posix.encodeFS str
+ r2 <- try @SomeException $ Posix.decodeFS r1
+ r3 <- evaluate $ force $ first displayException r2
+ pure (r3 === Right str)
+ )
+ , ("fromPlatformString* functions are equivalent under ASCII",
+ property $ \(PosixString . SBS.toShort . C.pack . nonNullAsciiString -> str) -> ioProperty $ do
+ r1 <- Posix.decodeFS str
+ r2 <- Posix.decodeUtf str
+ (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) str
+ (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) str
+ (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) str
+ pure ( r1 === r2
+ .&&. r1 === r3
+ .&&. r1 === r4
+ .&&. r1 === r5
+ )
+ )
+ , ("toPlatformString* functions are equivalent under ASCII",
+ property $ \(NonNullAsciiString str) -> ioProperty $ do
+ r1 <- Posix.encodeFS str
+ r2 <- Posix.encodeUtf str
+ (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
+ (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
+ (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
+ pure ( r1 === r2
+ .&&. r1 === r3
+ .&&. r1 === r4
+ .&&. r1 === r5
+ )
+ )
+ , ("Unit test toPlatformString*",
+ property $ ioProperty $ do
+ let str = "ABcK_(ツ123_&**"
+ let expected = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
+ r1 <- Posix.encodeFS str
+ r2 <- Posix.encodeUtf str
+ (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
+ (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
+ (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
+ pure ( r1 === expected
+ .&&. r2 === expected
+ .&&. r3 === expected
+ .&&. r4 === expected
+ .&&. r5 === expected
+ )
+ )
+ , ("Unit test fromPlatformString*",
+ property $ ioProperty $ do
+ let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
+ let expected = "ABcK_(ツ123_&**"
+ r1 <- Posix.decodeFS bs
+ r2 <- Posix.decodeUtf bs
+ (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) bs
+ (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) bs
+ (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) bs
+ pure ( r1 === expected
+ .&&. r2 === expected
+ .&&. r3 === expected
+ .&&. r4 === expected
+ .&&. r5 === expected
+ )
+ )
+ , ("pack . unpack == id (Posix)",
+ property $ \ws@(PosixString _) ->
+ Posix.pack (Posix.unpack ws) === ws
+ )
+ ]
+ ],
+ testGroup "QuasiQuoter"
+ [ testProperties "windows"
+ [ ("QuasiQuoter (WindowsPath)",
+ property $ do
+ let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f]
+ let expected = [Windows.pstr|ABcK_|]
+ bs === expected
+ )
+ , ("QuasiQuoter (WindowsString)",
+ property $ do
+ let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
+ let expected = [WindowsS.pstr|ABcK_(ツ123_&**|]
+ bs === expected
+ )
+ ],
+ testProperties "posix"
+ [ ("QuasiQuoter (PosixPath)",
+ property $ do
+ let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f]
+ let expected = [Posix.pstr|ABcK_|]
+ bs === expected
+ )
+ , ("QuasiQuoter (PosixString)",
+ property $ do
+ let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
+ let expected = [PosixS.pstr|ABcK_(ツ123_&**|]
+ bs === expected
+ )
+ ]
+ ],
+ testProperties "Type laws"
+ (QC.lawsProperties (QC.ordLaws (Proxy @OsPath))
+ ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsPath))
- , ("decodeUtf . encodeUtf == id (Posix)",
- property $ \(NonNullString str) -> (Posix.decodeUtf . fromJust . Posix.encodeUtf) str == Just str)
- , ("decodeUtf . encodeUtf == id (Windows)",
- property $ \(NonNullString str) -> (Windows.decodeUtf . fromJust . Windows.encodeUtf) str == Just str)
+ ++ QC.lawsProperties (QC.ordLaws (Proxy @OsString))
+ ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsString))
- , ("encodeWith ucs2le . decodeWith ucs2le == id (Posix)",
- property $ \(padEven -> bs) -> (Posix.encodeWith ucs2le . (\(Right r) -> r) . Posix.decodeWith ucs2le . OS.PS . toShort) bs === Right (OS.PS . toShort $ bs))
- , ("encodeWith ucs2le . decodeWith ucs2le == id (Windows)",
- property $ \(padEven -> bs) -> (Windows.encodeWith ucs2le . (\(Right r) -> r) . Windows.decodeWith ucs2le . OS.WS . toShort) bs
- === Right (OS.WS . toShort $ bs))
+ ++ QC.lawsProperties (QC.ordLaws (Proxy @WindowsString))
+ ++ QC.lawsProperties (QC.monoidLaws (Proxy @WindowsString))
- , ("decodeFS . encodeFS == id (Posix)",
- property $ \(NonNullString str) -> ioProperty $ do
- setFileSystemEncoding (mkUTF8 TransliterateCodingFailure)
- r1 <- Posix.encodeFS str
- r2 <- try @SomeException $ Posix.decodeFS r1
- r3 <- evaluate $ force $ first displayException r2
- pure (r3 === Right str)
- )
- , ("decodeFS . encodeFS == id (Windows)",
- property $ \(NonNullString str) -> ioProperty $ do
- r1 <- Windows.encodeFS str
- r2 <- try @SomeException $ Windows.decodeFS r1
- r3 <- evaluate $ force $ first displayException r2
- pure (r3 === Right str)
- )
+ ++ QC.lawsProperties (QC.ordLaws (Proxy @PosixString))
+ ++ QC.lawsProperties (QC.monoidLaws (Proxy @PosixString))
- , ("fromPlatformString* functions are equivalent under ASCII (Windows)",
- property $ \(WindowsString . BS16.pack . map (fromIntegral . ord) . nonNullAsciiString -> str) -> ioProperty $ do
- r1 <- Windows.decodeFS str
- r2 <- Windows.decodeUtf str
- (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) str
- (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) str
- (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) str
- pure ( r1 === r2
- .&&. r1 === r3
- .&&. r1 === r4
- .&&. r1 === r5
- )
- )
-
- , ("fromPlatformString* functions are equivalent under ASCII (Posix)",
- property $ \(PosixString . SBS.toShort . C.pack . nonNullAsciiString -> str) -> ioProperty $ do
- r1 <- Posix.decodeFS str
- r2 <- Posix.decodeUtf str
- (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) str
- (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) str
- (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) str
- pure ( r1 === r2
- .&&. r1 === r3
- .&&. r1 === r4
- .&&. r1 === r5
- )
- )
-
- , ("toPlatformString* functions are equivalent under ASCII (Windows)",
- property $ \(NonNullAsciiString str) -> ioProperty $ do
- r1 <- Windows.encodeFS str
- r2 <- Windows.encodeUtf str
- (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
- (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
- (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
- pure ( r1 === r2
- .&&. r1 === r3
- .&&. r1 === r4
- .&&. r1 === r5
- )
- )
-
- , ("toPlatformString* functions are equivalent under ASCII (Posix)",
- property $ \(NonNullAsciiString str) -> ioProperty $ do
- r1 <- Posix.encodeFS str
- r2 <- Posix.encodeUtf str
- (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
- (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
- (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
- pure ( r1 === r2
- .&&. r1 === r3
- .&&. r1 === r4
- .&&. r1 === r5
- )
- )
- , ("Unit test toPlatformString* (Posix)",
- property $ ioProperty $ do
- let str = "ABcK_(ツ123_&**"
- let expected = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
- r1 <- Posix.encodeFS str
- r2 <- Posix.encodeUtf str
- (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
- (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
- (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
- pure ( r1 === expected
- .&&. r2 === expected
- .&&. r3 === expected
- .&&. r4 === expected
- .&&. r5 === expected
- )
- )
- , ("Unit test toPlatformString* (WindowsString)",
- property $ ioProperty $ do
- let str = "ABcK_(ツ123_&**"
- let expected = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
- r1 <- Windows.encodeFS str
- r2 <- Windows.encodeUtf str
- (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
- (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
- (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
- pure ( r1 === expected
- .&&. r2 === expected
- .&&. r3 === expected
- .&&. r4 === expected
- .&&. r5 === expected
- )
- )
-
- , ("Unit test fromPlatformString* (Posix)",
- property $ ioProperty $ do
- let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
- let expected = "ABcK_(ツ123_&**"
- r1 <- Posix.decodeFS bs
- r2 <- Posix.decodeUtf bs
- (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) bs
- (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) bs
- (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) bs
- pure ( r1 === expected
- .&&. r2 === expected
- .&&. r3 === expected
- .&&. r4 === expected
- .&&. r5 === expected
- )
- )
- , ("Unit test fromPlatformString* (WindowsString)",
- property $ ioProperty $ do
- let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
- let expected = "ABcK_(ツ123_&**"
- r1 <- Windows.decodeFS bs
- r2 <- Windows.decodeUtf bs
- (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) bs
- (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) bs
- (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) bs
- pure ( r1 === expected
- .&&. r2 === expected
- .&&. r3 === expected
- .&&. r4 === expected
- .&&. r5 === expected
- )
- )
- , ("QuasiQuoter (WindowsString)",
- property $ do
- let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
- let expected = [WindowsS.pstr|ABcK_(ツ123_&**|]
- bs === expected
- )
- , ("QuasiQuoter (PosixString)",
- property $ do
- let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
- let expected = [PosixS.pstr|ABcK_(ツ123_&**|]
- bs === expected
- )
- , ("QuasiQuoter (WindowsPath)",
- property $ do
- let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f]
- let expected = [Windows.pstr|ABcK_|]
- bs === expected
- )
- , ("QuasiQuoter (PosixPath)",
- property $ do
- let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f]
- let expected = [Posix.pstr|ABcK_|]
- bs === expected
- )
-
- , ("pack . unpack == id (Windows)",
- property $ \ws@(WindowsString _) ->
- Windows.pack (Windows.unpack ws) === ws
- )
- , ("pack . unpack == id (Posix)",
- property $ \ws@(PosixString _) ->
- Posix.pack (Posix.unpack ws) === ws
- )
- , ("pack . unpack == id (OsPath)",
- property $ \ws@(OsString _) ->
- OSP.pack (OSP.unpack ws) === ws
- )
-
-
- ] ++ QC.lawsProperties (QC.ordLaws (Proxy @OsPath))
- ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsPath))
-
- ++ QC.lawsProperties (QC.ordLaws (Proxy @OsString))
- ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsString))
-
- ++ QC.lawsProperties (QC.ordLaws (Proxy @WindowsString))
- ++ QC.lawsProperties (QC.monoidLaws (Proxy @WindowsString))
-
- ++ QC.lawsProperties (QC.ordLaws (Proxy @PosixString))
- ++ QC.lawsProperties (QC.monoidLaws (Proxy @PosixString))
-
- ++ QC.lawsProperties (QC.ordLaws (Proxy @PlatformString))
- ++ QC.lawsProperties (QC.monoidLaws (Proxy @PlatformString))
+ ++ QC.lawsProperties (QC.ordLaws (Proxy @PlatformString))
+ ++ QC.lawsProperties (QC.monoidLaws (Proxy @PlatformString)))
+ ]
padEven :: ByteString -> ByteString
diff --git a/tests/abstract-filepath/Test.hs b/tests/abstract-filepath/Test.hs
index 00261b0e56ebfa6fbc35ffb68dec02882b1e0b85..31698b6b8463beda0501b40a43f778acd9882b14 100644
--- a/tests/abstract-filepath/Test.hs
+++ b/tests/abstract-filepath/Test.hs
@@ -1,7 +1,7 @@
module Main (main) where
import qualified OsPathSpec
-import TestUtil
+import Test.Tasty
main :: IO ()
-main = runTests (OsPathSpec.tests)
+main = defaultMain OsPathSpec.tests
diff --git a/tests/filepath-equivalent-tests/Gen.hs b/tests/filepath-equivalent-tests/Gen.hs
new file mode 100644
index 0000000000000000000000000000000000000000..97aa358ae0a4ef413175f4589a17c18d688e15d2
--- /dev/null
+++ b/tests/filepath-equivalent-tests/Gen.hs
@@ -0,0 +1,202 @@
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia, TypeOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DataKinds #-}
+
+module Gen where
+
+import System.FilePath
+import Data.List.NonEmpty (NonEmpty(..))
+import GHC.Generics
+import Generic.Random
+import Generics.Deriving.Show
+import Prelude as P
+import Test.Tasty.QuickCheck hiding ((==>))
+
+import qualified Data.List.NonEmpty as NE
+
+
+class AltShow a where
+ altShow :: a -> String
+
+instance {-# OVERLAPPABLE #-} Show a => AltShow a where
+ altShow = show
+
+instance {-# OVERLAPS #-} AltShow String where
+ altShow = id
+
+instance {-# OVERLAPPABLE #-} AltShow a => AltShow (Maybe a) where
+ altShow Nothing = ""
+ altShow (Just a) = altShow a
+
+
+newtype WindowsFilePaths = WindowsFilePaths { unWindowsFilePaths :: [WindowsFilePath] }
+ deriving (Show, Eq, Ord, Generic)
+
+-- filepath = namespace *"\" namespace-tail
+-- / UNC
+-- / [ disk ] *"\" relative-path
+-- / disk *"\"
+data WindowsFilePath = NS NameSpace [Separator] NSTail
+ | UNC UNCShare
+ | N (Maybe Char) [Separator] (Maybe RelFilePath)
+ -- ^ This differs from the grammar, because we allow
+ -- empty paths
+ | PotentiallyInvalid FilePath
+ -- ^ this branch is added purely for the tests
+ deriving (GShow, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[6, 2, 2, 1] `AndShrinking` WindowsFilePath)
+
+instance Show WindowsFilePath where
+ show wf = gshow wf ++ " (" ++ altShow wf ++ ")"
+
+instance AltShow WindowsFilePath where
+ altShow (NS ns seps nstail) = altShow ns ++ altShow seps ++ altShow nstail
+ altShow (UNC unc) = altShow unc
+ altShow (N mdisk seps mfrp) = maybe [] (:[]) mdisk ++ (altShow seps ++ altShow mfrp)
+ altShow (PotentiallyInvalid fp) = fp
+
+
+-- namespace-tail = ( disk 1*"\" relative-path ; C:foo\bar is not valid
+-- ; namespaced paths are all absolute
+-- / disk *"\"
+-- / relative-path
+-- )
+data NSTail = NST1 Char (NonEmpty Separator) RelFilePath
+ | NST2 Char [Separator]
+ | NST3 RelFilePath
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[1, 1, 1] `AndShrinking` NSTail)
+
+instance AltShow NSTail where
+ altShow (NST1 disk seps relfp) = disk:':':(altShow seps ++ altShow relfp)
+ altShow (NST2 disk seps) = disk:':':altShow seps
+ altShow (NST3 relfp) = altShow relfp
+
+
+-- UNC = "\\" 1*pchar "\" 1*pchar [ 1*"\" [ relative-path ] ]
+data UNCShare = UNCShare Separator Separator
+ NonEmptyString
+ (NonEmpty Separator)
+ NonEmptyString
+ (Maybe (NonEmpty Separator, Maybe RelFilePath))
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[1] `AndShrinking` UNCShare)
+
+instance AltShow UNCShare where
+ altShow (UNCShare sep1 sep2 fp1 seps fp2 mrfp) = altShow sep1 ++ altShow sep2 ++ altShow fp1 ++ altShow seps ++ altShow fp2 ++ maybe "" (\(a, b) -> altShow a ++ maybe "" altShow b) mrfp
+
+newtype NonEmptyString = NonEmptyString (NonEmpty Char)
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[1] `AndShrinking` NonEmptyString)
+
+instance Semigroup NonEmptyString where
+ (<>) (NonEmptyString ne) (NonEmptyString ne') = NonEmptyString (ne <> ne')
+
+instance AltShow NonEmptyString where
+ altShow (NonEmptyString ns) = NE.toList ns
+
+
+-- | Windows API Namespaces
+--
+-- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#namespaces
+-- https://support.microsoft.com/en-us/topic/70b92942-a643-2f2d-2ac6-aad8acad49fb
+-- https://superuser.com/a/1096784/854039
+-- https://reverseengineering.stackexchange.com/a/15178
+-- https://stackoverflow.com/a/25099634
+--
+-- namespace = file-namespace / device-namespace / nt-namespace
+-- file-namespace = "\" "\" "?" "\"
+-- device-namespace = "\" "\" "." "\"
+-- nt-namespace = "\" "?" "?" "\"
+data NameSpace = FileNameSpace
+ | DeviceNameSpace
+ | NTNameSpace
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[3, 1, 1] `AndShrinking` NameSpace)
+
+instance AltShow NameSpace where
+ altShow FileNameSpace = "\\\\?\\"
+ altShow DeviceNameSpace = "\\\\.\\"
+ altShow NTNameSpace = "\\??\\"
+
+
+data Separator = UnixSep
+ | WindowsSep
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[1, 1] `AndShrinking` Separator)
+
+instance AltShow Separator where
+ altShow UnixSep = "/"
+ altShow WindowsSep = "\\"
+
+instance {-# OVERLAPS #-} AltShow (NonEmpty Separator) where
+ altShow ne = mconcat $ NE.toList (altShow <$> ne)
+
+instance {-# OVERLAPS #-} AltShow [Separator] where
+ altShow [] = ""
+ altShow ne = altShow (NE.fromList ne)
+
+-- relative-path = 1*(path-name 1*"\") [ file-name ] / file-name
+data RelFilePath = Rel1 (NonEmpty (NonEmptyString, NonEmpty Separator)) (Maybe FileName)
+ | Rel2 FileName
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[2, 1] `AndShrinking` RelFilePath)
+
+instance AltShow RelFilePath where
+ altShow (Rel1 ns mf) = mconcat (NE.toList $ fmap (\(a, b) -> altShow a ++ altShow b) ns) ++ altShow mf
+ altShow (Rel2 fn) = altShow fn
+
+-- file-name = 1*pchar [ stream ]
+data FileName = FileName NonEmptyString (Maybe DataStream)
+ deriving (GShow, Show, Eq, Ord, Generic)
+
+instance Arbitrary FileName where
+ -- make sure that half of the filenames include a dot '.'
+ -- so that we can deal with extensions
+ arbitrary = do
+ ns <- arbitrary
+ ds <- arbitrary
+ i <- chooseInt (0, 100)
+ if i >= 50
+ then do
+ ns' <- arbitrary
+ pure $ FileName (ns <> NonEmptyString ('.':|[]) <> ns') ds
+ else pure $ FileName ns ds
+ shrink = genericShrink
+
+
+instance Arbitrary (Maybe DataStream) where
+ arbitrary = genericArbitraryRec (1 % 1 % ())
+ shrink = genericShrink
+
+instance AltShow FileName where
+ altShow (FileName ns ds) = altShow ns ++ altShow ds
+
+-- stream = ":" 1*schar [ ":" 1*schar ] / ":" ":" 1*schar
+data DataStream = DS1 NonEmptyString (Maybe NonEmptyString)
+ | DS2 NonEmptyString -- ::datatype
+ deriving (GShow, Show, Eq, Ord, Generic)
+ deriving Arbitrary via (GenericArbitraryRec '[1, 1] `AndShrinking` DataStream)
+
+instance AltShow DataStream where
+ altShow (DS1 ns Nothing) = ":" ++ altShow ns
+ altShow (DS1 ns (Just ns2)) = ":" ++ altShow ns ++ ":" ++ altShow ns2
+ altShow (DS2 ns) = "::" ++ altShow ns
+
+instance Arbitrary WindowsFilePaths where
+ arbitrary = WindowsFilePaths <$> listOf' arbitrary
+ shrink = genericShrink
+
+instance Arbitrary [Separator] where
+ arbitrary = listOf' arbitrary
+ shrink = genericShrink
+
+instance Arbitrary a => Arbitrary (NonEmpty a) where
+ arbitrary = NE.fromList <$> listOf1' arbitrary
+ shrink = genericShrink
+
diff --git a/tests/filepath-equivalent-tests/TestEquiv.hs b/tests/filepath-equivalent-tests/TestEquiv.hs
index 4405ea4042f13b2b570fb90b321da788c587f303..339ce1ace63a7b0befe8952beac9b0b886f306ad 100644
--- a/tests/filepath-equivalent-tests/TestEquiv.hs
+++ b/tests/filepath-equivalent-tests/TestEquiv.hs
@@ -1,12 +1,9 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia, TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeApplications #-}
module Main where
@@ -16,177 +13,12 @@ import Test.Tasty.QuickCheck hiding ((==>))
import TestUtil
import Prelude as P
import Data.Char (isAsciiLower, isAsciiUpper)
-import Data.List.NonEmpty (NonEmpty(..))
-import Generic.Random
-import Generics.Deriving.Show
-import GHC.Generics
+import Gen
import qualified System.FilePath.Windows as W
import qualified System.FilePath.Posix as P
import qualified Legacy.System.FilePath.Windows as LW
import qualified Legacy.System.FilePath.Posix as LP
-import qualified Data.List.NonEmpty as NE
-
-
-class AltShow a where
- altShow :: a -> String
-
-instance {-# OVERLAPPABLE #-} Show a => AltShow a where
- altShow = show
-
-instance {-# OVERLAPS #-} AltShow String where
- altShow = id
-
-instance {-# OVERLAPPABLE #-} AltShow a => AltShow (Maybe a) where
- altShow Nothing = ""
- altShow (Just a) = altShow a
-
-
-newtype WindowsFilePaths = WindowsFilePaths { unWindowsFilePaths :: [WindowsFilePath] }
- deriving (Show, Eq, Ord, Generic)
-
--- filepath = namespace *"\" namespace-tail
--- / UNC
--- / [ disk ] *"\" relative-path
--- / disk *"\"
-data WindowsFilePath = NS NameSpace [Separator] NSTail
- | UNC UNCShare
- | N (Maybe Char) [Separator] (Maybe RelFilePath)
- -- ^ This differs from the grammar, because we allow
- -- empty paths
- | PotentiallyInvalid FilePath
- -- ^ this branch is added purely for the tests
- deriving (GShow, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` WindowsFilePath)
-
-instance Show WindowsFilePath where
- show wf = gshow wf ++ " (" ++ altShow wf ++ ")"
-
-instance AltShow WindowsFilePath where
- altShow (NS ns seps nstail) = altShow ns ++ altShow seps ++ altShow nstail
- altShow (UNC unc) = altShow unc
- altShow (N mdisk seps mfrp) = maybe [] (:[]) mdisk ++ (altShow seps ++ maybe "" altShow mfrp)
- altShow (PotentiallyInvalid fp) = fp
-
-
--- namespace-tail = ( disk 1*"\" relative-path ; C:foo\bar is not valid
--- ; namespaced paths are all absolute
--- / disk *"\"
--- / relative-path
--- )
-data NSTail = NST1 Char (NonEmpty Separator) RelFilePath
- | NST2 Char [Separator]
- | NST3 RelFilePath
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` NSTail)
-
-instance AltShow NSTail where
- altShow (NST1 disk seps relfp) = disk:':':(altShow seps ++ altShow relfp)
- altShow (NST2 disk seps) = disk:':':altShow seps
- altShow (NST3 relfp) = altShow relfp
-
-
--- UNC = "\\" 1*pchar "\" 1*pchar [ 1*"\" [ relative-path ] ]
-data UNCShare = UNCShare Separator Separator
- NonEmptyString
- (NonEmpty Separator)
- NonEmptyString
- (Maybe (NonEmpty Separator, Maybe RelFilePath))
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` UNCShare)
-
-instance AltShow UNCShare where
- altShow (UNCShare sep1 sep2 fp1 seps fp2 mrfp) = altShow sep1 ++ altShow sep2 ++ altShow fp1 ++ altShow seps ++ altShow fp2 ++ maybe "" (\(a, b) -> altShow a ++ maybe "" altShow b) mrfp
-
-newtype NonEmptyString = NonEmptyString (NonEmpty Char)
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` NonEmptyString)
-
-instance AltShow NonEmptyString where
- altShow (NonEmptyString ns) = NE.toList ns
-
-
--- | Windows API Namespaces
---
--- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#namespaces
--- https://support.microsoft.com/en-us/topic/70b92942-a643-2f2d-2ac6-aad8acad49fb
--- https://superuser.com/a/1096784/854039
--- https://reverseengineering.stackexchange.com/a/15178
--- https://stackoverflow.com/a/25099634
---
--- namespace = file-namespace / device-namespace / nt-namespace
--- file-namespace = "\" "\" "?" "\"
--- device-namespace = "\" "\" "." "\"
--- nt-namespace = "\" "?" "?" "\"
-data NameSpace = FileNameSpace
- | DeviceNameSpace
- | NTNameSpace
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` NameSpace)
-
-instance AltShow NameSpace where
- altShow FileNameSpace = "\\\\?\\"
- altShow DeviceNameSpace = "\\\\.\\"
- altShow NTNameSpace = "\\??\\"
-
-
-data Separator = UnixSep
- | WindowsSep
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` Separator)
-
-instance AltShow Separator where
- altShow UnixSep = "/"
- altShow WindowsSep = "\\"
-
-instance {-# OVERLAPS #-} AltShow (NonEmpty Separator) where
- altShow ne = mconcat $ NE.toList (altShow <$> ne)
-
-instance {-# OVERLAPS #-} AltShow [Separator] where
- altShow [] = ""
- altShow ne = altShow (NE.fromList ne)
-
--- relative-path = 1*(path-name 1*"\") [ file-name ] / file-name
-data RelFilePath = Rel1 (NonEmpty (NonEmptyString, NonEmpty Separator)) (Maybe FileName)
- | Rel2 FileName
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` RelFilePath)
-
-instance AltShow RelFilePath where
- altShow (Rel1 ns mf) = (mconcat $ NE.toList $ fmap (\(a, b) -> altShow a ++ altShow b) ns) ++ maybe "" altShow mf
- altShow (Rel2 fn) = altShow fn
-
--- file-name = 1*pchar [ stream ]
-data FileName = FileName NonEmptyString (Maybe DataStream)
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` FileName)
-
-instance AltShow FileName where
- altShow (FileName ns ds) = altShow ns ++ altShow ds
-
--- stream = ":" 1*schar [ ":" 1*schar ] / ":" ":" 1*schar
-data DataStream = DS1 NonEmptyString (Maybe NonEmptyString)
- | DS2 NonEmptyString -- ::datatype
- deriving (GShow, Show, Eq, Ord, Generic)
- deriving Arbitrary via (GenericArbitraryU `AndShrinking` DataStream)
-
-instance AltShow DataStream where
- altShow (DS1 ns Nothing) = ":" ++ altShow ns
- altShow (DS1 ns (Just ns2)) = ":" ++ altShow ns ++ ":" ++ altShow ns2
- altShow (DS2 ns) = "::" ++ altShow ns
-
-instance Arbitrary WindowsFilePaths where
- arbitrary = scale (`mod` 20) $ genericArbitrary uniform
-
-instance Arbitrary [Separator] where
- arbitrary = scale (`mod` 20) $ genericArbitrary uniform
-
-instance Arbitrary a => Arbitrary (NonEmpty a) where
- arbitrary = scale (`mod` 20) $ do
- x <- arbitrary
- case x of
- [] -> (NE.fromList . (:[])) <$> arbitrary
- xs -> pure (NE.fromList xs)
main :: IO ()
@@ -194,417 +26,408 @@ main = defaultMain equivalentTests
equivalentTests :: TestTree
-equivalentTests = testProperties "equivalence" $
- [
- ( "pathSeparator (windows)"
- , property $ W.pathSeparator == LW.pathSeparator
- )
- ,
- ( "pathSeparators (windows)"
- , property $ W.pathSeparators == LW.pathSeparators
- )
- ,
- ( "isPathSeparator (windows)"
- , property $ \p -> W.isPathSeparator p == LW.isPathSeparator p
- )
- ,
- ( "searchPathSeparator (windows)"
- , property $ W.searchPathSeparator == LW.searchPathSeparator
- )
- ,
- ( "isSearchPathSeparator (windows)"
- , property $ \p -> W.isSearchPathSeparator p == LW.isSearchPathSeparator p
- )
- ,
- ( "extSeparator (windows)"
- , property $ W.extSeparator == LW.extSeparator
- )
- ,
- ( "isExtSeparator (windows)"
- , property $ \p -> W.isExtSeparator p == LW.isExtSeparator p
- )
- ,
- ( "splitSearchPath (windows)"
- , property $ \(xs :: WindowsFilePaths)
- -> let p = (intercalate ";" (altShow <$> unWindowsFilePaths xs))
- in W.splitSearchPath p == LW.splitSearchPath p
- )
- ,
- ( "splitExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtension p == LW.splitExtension p
- )
- ,
- ( "takeExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.takeExtension p == LW.takeExtension p
- )
- ,
- ( "replaceExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtension p s == LW.replaceExtension p s
- )
- ,
- ( "dropExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtension p == LW.dropExtension p
- )
- ,
- ( "addExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.addExtension p s == LW.addExtension p s
- )
- ,
- ( "hasExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.hasExtension p == LW.hasExtension p
- )
- ,
- ( "splitExtensions (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtensions p == LW.splitExtensions p
- )
- ,
- ( "dropExtensions (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtensions p == LW.dropExtensions p
- )
- ,
- ( "takeExtensions (windows)"
- , property $ \p -> W.takeExtensions p == LW.takeExtensions p
- )
- ,
- ( "replaceExtensions (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtensions p s == LW.replaceExtensions p s
- )
- ,
- ( "isExtensionOf (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.isExtensionOf p s == LW.isExtensionOf p s
- )
- ,
- ( "stripExtension (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.stripExtension p s == LW.stripExtension p s
- )
- ,
- ( "splitFileName (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.splitFileName p == LW.splitFileName p
- )
- ,
- ( "takeFileName (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.takeFileName p == LW.takeFileName p
- )
- ,
- ( "replaceFileName (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceFileName p s == LW.replaceFileName p s
- )
- ,
- ( "dropFileName (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.dropFileName p == LW.dropFileName p
- )
- ,
- ( "takeBaseName (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.takeBaseName p == LW.takeBaseName p
- )
- ,
- ( "replaceBaseName (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceBaseName p s == LW.replaceBaseName p s
- )
- ,
- ( "takeDirectory (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.takeDirectory p == LW.takeDirectory p
- )
- ,
- ( "replaceDirectory (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceDirectory p s == LW.replaceDirectory p s
- )
- ,
- ( "combine (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.combine p s == LW.combine p s
- )
- ,
- ( "splitPath (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.splitPath p == LW.splitPath p
- )
- ,
- ( "joinPath (windows)"
- , property $ \(xs :: WindowsFilePaths) ->
- let p = altShow <$> unWindowsFilePaths xs
- in W.joinPath p == LW.joinPath p
- )
- ,
- ( "splitDirectories (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.splitDirectories p == LW.splitDirectories p
- )
- ,
- ( "splitDrive (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.splitDrive p == LW.splitDrive p
- )
- ,
- ( "joinDrive (windows)"
- , property $ \(altShow @WindowsFilePath -> p) s -> W.joinDrive p s == LW.joinDrive p s
- )
- ,
- ( "takeDrive (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.takeDrive p == LW.takeDrive p
- )
- ,
- ( "hasDrive (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.hasDrive p == LW.hasDrive p
- )
- ,
- ( "dropDrive (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.dropDrive p == LW.dropDrive p
- )
- ,
- ( "isDrive (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.isDrive p == LW.isDrive p
- )
- ,
- ( "hasTrailingPathSeparator (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p
- )
- ,
- ( "addTrailingPathSeparator (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p
- )
- ,
- ( "dropTrailingPathSeparator (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p
- )
- ,
- ( "normalise (windows)"
- , property $ \(altShow @WindowsFilePath -> p) -> case p of
- (l:':':rs)
- -- new filepath normalises "a:////////" to "A:\\"
- -- see https://github.com/haskell/filepath/commit/cb4890aa03a5ee61f16f7a08dd2d964fffffb385
- | isAsciiLower l || isAsciiUpper l
- , let (seps, path) = span LW.isPathSeparator rs
- , length seps > 1 -> let np = l : ':' : LW.pathSeparator : path in W.normalise np == LW.normalise np
- _ -> W.normalise p == LW.normalise p
- )
- ,
- ( "equalFilePath (windows)"
- , property $ \p s -> W.equalFilePath p s == LW.equalFilePath p s
- )
- ,
- ( "makeRelative (windows)"
- , property $ \p s -> W.makeRelative p s == LW.makeRelative p s
- )
- ,
- ( "isRelative (windows)"
- , property $ \p -> W.isRelative p == LW.isRelative p
- )
- ,
- ( "isAbsolute (windows)"
- , property $ \p -> W.isAbsolute p == LW.isAbsolute p
- )
- ,
- ( "isValid (windows)"
- , property $ \p -> W.isValid p == LW.isValid p
- )
- ,
- ( "makeValid (windows)"
- , property $ \p -> W.makeValid p == LW.makeValid p
- )
- ,
- ( "pathSeparator (posix)"
- , property $ P.pathSeparator == LP.pathSeparator
- )
- ,
- ( "pathSeparators (posix)"
- , property $ P.pathSeparators == LP.pathSeparators
- )
- ,
- ( "isPathSeparator (posix)"
- , property $ \p -> P.isPathSeparator p == LP.isPathSeparator p
- )
- ,
- ( "searchPathSeparator (posix)"
- , property $ P.searchPathSeparator == LP.searchPathSeparator
- )
- ,
- ( "isSearchPathSeparator (posix)"
- , property $ \p -> P.isSearchPathSeparator p == LP.isSearchPathSeparator p
- )
- ,
- ( "extSeparator (posix)"
- , property $ P.extSeparator == LP.extSeparator
- )
- ,
- ( "isExtSeparator (posix)"
- , property $ \p -> P.isExtSeparator p == LP.isExtSeparator p
- )
- ,
- ( "splitSearchPath (posix)"
- , property $ \p -> P.splitSearchPath p == LP.splitSearchPath p
- )
- ,
- ( "splitExtension (posix)"
- , property $ \p -> P.splitExtension p == LP.splitExtension p
- )
- ,
- ( "takeExtension (posix)"
- , property $ \p -> P.takeExtension p == LP.takeExtension p
- )
- ,
- ( "replaceExtension (posix)"
- , property $ \p s -> P.replaceExtension p s == LP.replaceExtension p s
- )
- ,
- ( "dropExtension (posix)"
- , property $ \p -> P.dropExtension p == LP.dropExtension p
- )
- ,
- ( "addExtension (posix)"
- , property $ \p s -> P.addExtension p s == LP.addExtension p s
- )
- ,
- ( "hasExtension (posix)"
- , property $ \p -> P.hasExtension p == LP.hasExtension p
- )
- ,
- ( "splitExtensions (posix)"
- , property $ \p -> P.splitExtensions p == LP.splitExtensions p
- )
- ,
- ( "dropExtensions (posix)"
- , property $ \p -> P.dropExtensions p == LP.dropExtensions p
- )
- ,
- ( "takeExtensions (posix)"
- , property $ \p -> P.takeExtensions p == LP.takeExtensions p
- )
- ,
- ( "replaceExtensions (posix)"
- , property $ \p s -> P.replaceExtensions p s == LP.replaceExtensions p s
- )
- ,
- ( "isExtensionOf (posix)"
- , property $ \p s -> P.isExtensionOf p s == LP.isExtensionOf p s
- )
- ,
- ( "stripExtension (posix)"
- , property $ \p s -> P.stripExtension p s == LP.stripExtension p s
- )
- ,
- ( "splitFileName (posix)"
- , property $ \p -> P.splitFileName p == LP.splitFileName p
- )
- ,
- ( "takeFileName (posix)"
- , property $ \p -> P.takeFileName p == LP.takeFileName p
- )
- ,
- ( "replaceFileName (posix)"
- , property $ \p s -> P.replaceFileName p s == LP.replaceFileName p s
- )
- ,
- ( "dropFileName (posix)"
- , property $ \p -> P.dropFileName p == LP.dropFileName p
- )
- ,
- ( "takeBaseName (posix)"
- , property $ \p -> P.takeBaseName p == LP.takeBaseName p
- )
- ,
- ( "replaceBaseName (posix)"
- , property $ \p s -> P.replaceBaseName p s == LP.replaceBaseName p s
- )
- ,
- ( "takeDirectory (posix)"
- , property $ \p -> P.takeDirectory p == LP.takeDirectory p
- )
- ,
- ( "replaceDirectory (posix)"
- , property $ \p s -> P.replaceDirectory p s == LP.replaceDirectory p s
- )
- ,
- ( "combine (posix)"
- , property $ \p s -> P.combine p s == LP.combine p s
- )
- ,
- ( "splitPath (posix)"
- , property $ \p -> P.splitPath p == LP.splitPath p
- )
- ,
- ( "joinPath (posix)"
- , property $ \p -> P.joinPath p == LP.joinPath p
- )
- ,
- ( "splitDirectories (posix)"
- , property $ \p -> P.splitDirectories p == LP.splitDirectories p
- )
- ,
- ( "splitDirectories (posix)"
- , property $ \p -> P.splitDirectories p == LP.splitDirectories p
- )
- ,
- ( "splitDrive (posix)"
- , property $ \p -> P.splitDrive p == LP.splitDrive p
- )
- ,
- ( "joinDrive (posix)"
- , property $ \p s -> P.joinDrive p s == LP.joinDrive p s
- )
- ,
- ( "takeDrive (posix)"
- , property $ \p -> P.takeDrive p == LP.takeDrive p
- )
- ,
- ( "hasDrive (posix)"
- , property $ \p -> P.hasDrive p == LP.hasDrive p
- )
- ,
- ( "dropDrive (posix)"
- , property $ \p -> P.dropDrive p == LP.dropDrive p
- )
- ,
- ( "isDrive (posix)"
- , property $ \p -> P.isDrive p == LP.isDrive p
- )
- ,
- ( "hasTrailingPathSeparator (posix)"
- , property $ \p -> P.hasTrailingPathSeparator p == LP.hasTrailingPathSeparator p
- )
- ,
- ( "addTrailingPathSeparator (posix)"
- , property $ \p -> P.addTrailingPathSeparator p == LP.addTrailingPathSeparator p
- )
- ,
- ( "dropTrailingPathSeparator (posix)"
- , property $ \p -> P.dropTrailingPathSeparator p == LP.dropTrailingPathSeparator p
- )
- ,
- ( "normalise (posix)"
- , property $ \p -> P.normalise p == LP.normalise p
- )
- ,
- ( "equalFilePath (posix)"
- , property $ \p s -> P.equalFilePath p s == LP.equalFilePath p s
- )
- ,
- ( "makeRelative (posix)"
- , property $ \p s -> P.makeRelative p s == LP.makeRelative p s
- )
- ,
- ( "isRelative (posix)"
- , property $ \p -> P.isRelative p == LP.isRelative p
- )
- ,
- ( "isAbsolute (posix)"
- , property $ \p -> P.isAbsolute p == LP.isAbsolute p
- )
- ,
- ( "isValid (posix)"
- , property $ \p -> P.isValid p == LP.isValid p
- )
- ,
- ( "makeValid (posix)"
- , property $ \p -> P.makeValid p == LP.makeValid p
- )
+equivalentTests = testGroup "equivalence"
+ [ testProperties "windows"
+ [
+ ( "pathSeparator"
+ , property $ W.pathSeparator == LW.pathSeparator
+ )
+ ,
+ ( "pathSeparators"
+ , property $ W.pathSeparators == LW.pathSeparators
+ )
+ ,
+ ( "isPathSeparator"
+ , property $ \p -> W.isPathSeparator p == LW.isPathSeparator p
+ )
+ ,
+ ( "searchPathSeparator"
+ , property $ W.searchPathSeparator == LW.searchPathSeparator
+ )
+ ,
+ ( "isSearchPathSeparator"
+ , property $ \p -> W.isSearchPathSeparator p == LW.isSearchPathSeparator p
+ )
+ ,
+ ( "extSeparator"
+ , property $ W.extSeparator == LW.extSeparator
+ )
+ ,
+ ( "isExtSeparator"
+ , property $ \p -> W.isExtSeparator p == LW.isExtSeparator p
+ )
+ ,
+ ( "splitSearchPath"
+ , property $ \(xs :: WindowsFilePaths)
+ -> let p = (intercalate ";" (altShow <$> unWindowsFilePaths xs))
+ in W.splitSearchPath p == LW.splitSearchPath p
+ )
+ ,
+ ( "splitExtension"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtension p == LW.splitExtension p
+ )
+ ,
+ ( "takeExtension"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.takeExtension p == LW.takeExtension p
+ )
+ ,
+ ( "replaceExtension"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtension p s == LW.replaceExtension p s
+ )
+ ,
+ ( "dropExtension"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtension p == LW.dropExtension p
+ )
+ ,
+ ( "addExtension"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.addExtension p s == LW.addExtension p s
+ )
+ ,
+ ( "hasExtension"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.hasExtension p == LW.hasExtension p
+ )
+ ,
+ ( "splitExtensions"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.splitExtensions p == LW.splitExtensions p
+ )
+ ,
+ ( "dropExtensions"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.dropExtensions p == LW.dropExtensions p
+ )
+ ,
+ ( "takeExtensions"
+ , property $ \p -> W.takeExtensions p == LW.takeExtensions p
+ )
+ ,
+ ( "replaceExtensions"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceExtensions p s == LW.replaceExtensions p s
+ )
+ ,
+ ( "isExtensionOf"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.isExtensionOf p s == LW.isExtensionOf p s
+ )
+ ,
+ ( "stripExtension"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.stripExtension p s == LW.stripExtension p s
+ )
+ ,
+ ( "splitFileName"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.splitFileName p == LW.splitFileName p
+ )
+ ,
+ ( "takeFileName"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.takeFileName p == LW.takeFileName p
+ )
+ ,
+ ( "replaceFileName"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceFileName p s == LW.replaceFileName p s
+ )
+ ,
+ ( "dropFileName"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.dropFileName p == LW.dropFileName p
+ )
+ ,
+ ( "takeBaseName"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.takeBaseName p == LW.takeBaseName p
+ )
+ ,
+ ( "replaceBaseName"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceBaseName p s == LW.replaceBaseName p s
+ )
+ ,
+ ( "takeDirectory"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.takeDirectory p == LW.takeDirectory p
+ )
+ ,
+ ( "replaceDirectory"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.replaceDirectory p s == LW.replaceDirectory p s
+ )
+ ,
+ ( "combine"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.combine p s == LW.combine p s
+ )
+ ,
+ ( "splitPath"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.splitPath p == LW.splitPath p
+ )
+ ,
+ ( "joinPath"
+ , property $ \(xs :: WindowsFilePaths) ->
+ let p = altShow <$> unWindowsFilePaths xs
+ in W.joinPath p == LW.joinPath p
+ )
+ ,
+ ( "splitDirectories"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.splitDirectories p == LW.splitDirectories p
+ )
+ ,
+ ( "splitDrive"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.splitDrive p == LW.splitDrive p
+ )
+ ,
+ ( "joinDrive"
+ , property $ \(altShow @WindowsFilePath -> p) s -> W.joinDrive p s == LW.joinDrive p s
+ )
+ ,
+ ( "takeDrive"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.takeDrive p == LW.takeDrive p
+ )
+ ,
+ ( "hasDrive"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.hasDrive p == LW.hasDrive p
+ )
+ ,
+ ( "dropDrive"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.dropDrive p == LW.dropDrive p
+ )
+ ,
+ ( "isDrive"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.isDrive p == LW.isDrive p
+ )
+ ,
+ ( "hasTrailingPathSeparator"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p
+ )
+ ,
+ ( "addTrailingPathSeparator"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p
+ )
+ ,
+ ( "dropTrailingPathSeparator"
+ , property $ \(altShow @WindowsFilePath -> p) -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p
+ )
+ ,
+ ( "normalise"
+ , property $ \(altShow @WindowsFilePath -> p) -> case p of
+ (l:':':rs)
+ -- new filepath normalises "a:////////" to "A:\\"
+ -- see https://github.com/haskell/filepath/commit/cb4890aa03a5ee61f16f7a08dd2d964fffffb385
+ | isAsciiLower l || isAsciiUpper l
+ , let (seps, path) = span LW.isPathSeparator rs
+ , length seps > 1 -> let np = l : ':' : LW.pathSeparator : path in W.normalise np == LW.normalise np
+ _ -> W.normalise p == LW.normalise p
+ )
+ ,
+ ( "equalFilePath"
+ , property $ \p s -> W.equalFilePath p s == LW.equalFilePath p s
+ )
+ ,
+ ( "makeRelative"
+ , property $ \p s -> W.makeRelative p s == LW.makeRelative p s
+ )
+ ,
+ ( "isRelative"
+ , property $ \p -> W.isRelative p == LW.isRelative p
+ )
+ ,
+ ( "isAbsolute"
+ , property $ \p -> W.isAbsolute p == LW.isAbsolute p
+ )
+ ,
+ ( "isValid"
+ , property $ \p -> W.isValid p == LW.isValid p
+ )
+ ,
+ ( "makeValid"
+ , property $ \p -> W.makeValid p == LW.makeValid p
+ )
+ ],
+ testProperties "posix" $ [
+ ( "pathSeparator"
+ , property $ P.pathSeparator == LP.pathSeparator
+ )
+ ,
+ ( "pathSeparators"
+ , property $ P.pathSeparators == LP.pathSeparators
+ )
+ ,
+ ( "isPathSeparator"
+ , property $ \p -> P.isPathSeparator p == LP.isPathSeparator p
+ )
+ ,
+ ( "searchPathSeparator"
+ , property $ P.searchPathSeparator == LP.searchPathSeparator
+ )
+ ,
+ ( "isSearchPathSeparator"
+ , property $ \p -> P.isSearchPathSeparator p == LP.isSearchPathSeparator p
+ )
+ ,
+ ( "extSeparator"
+ , property $ P.extSeparator == LP.extSeparator
+ )
+ ,
+ ( "isExtSeparator"
+ , property $ \p -> P.isExtSeparator p == LP.isExtSeparator p
+ )
+ ,
+ ( "splitSearchPath"
+ , property $ \p -> P.splitSearchPath p == LP.splitSearchPath p
+ )
+ ,
+ ( "splitExtension"
+ , property $ \p -> P.splitExtension p == LP.splitExtension p
+ )
+ ,
+ ( "takeExtension"
+ , property $ \p -> P.takeExtension p == LP.takeExtension p
+ )
+ ,
+ ( "replaceExtension"
+ , property $ \p s -> P.replaceExtension p s == LP.replaceExtension p s
+ )
+ ,
+ ( "dropExtension"
+ , property $ \p -> P.dropExtension p == LP.dropExtension p
+ )
+ ,
+ ( "addExtension"
+ , property $ \p s -> P.addExtension p s == LP.addExtension p s
+ )
+ ,
+ ( "hasExtension"
+ , property $ \p -> P.hasExtension p == LP.hasExtension p
+ )
+ ,
+ ( "splitExtensions"
+ , property $ \p -> P.splitExtensions p == LP.splitExtensions p
+ )
+ ,
+ ( "dropExtensions"
+ , property $ \p -> P.dropExtensions p == LP.dropExtensions p
+ )
+ ,
+ ( "takeExtensions"
+ , property $ \p -> P.takeExtensions p == LP.takeExtensions p
+ )
+ ,
+ ( "replaceExtensions"
+ , property $ \p s -> P.replaceExtensions p s == LP.replaceExtensions p s
+ )
+ ,
+ ( "isExtensionOf"
+ , property $ \p s -> P.isExtensionOf p s == LP.isExtensionOf p s
+ )
+ ,
+ ( "stripExtension"
+ , property $ \p s -> P.stripExtension p s == LP.stripExtension p s
+ )
+ ,
+ ( "splitFileName"
+ , property $ \p -> P.splitFileName p == LP.splitFileName p
+ )
+ ,
+ ( "takeFileName"
+ , property $ \p -> P.takeFileName p == LP.takeFileName p
+ )
+ ,
+ ( "replaceFileName"
+ , property $ \p s -> P.replaceFileName p s == LP.replaceFileName p s
+ )
+ ,
+ ( "dropFileName"
+ , property $ \p -> P.dropFileName p == LP.dropFileName p
+ )
+ ,
+ ( "takeBaseName"
+ , property $ \p -> P.takeBaseName p == LP.takeBaseName p
+ )
+ ,
+ ( "replaceBaseName"
+ , property $ \p s -> P.replaceBaseName p s == LP.replaceBaseName p s
+ )
+ ,
+ ( "takeDirectory"
+ , property $ \p -> P.takeDirectory p == LP.takeDirectory p
+ )
+ ,
+ ( "replaceDirectory"
+ , property $ \p s -> P.replaceDirectory p s == LP.replaceDirectory p s
+ )
+ ,
+ ( "combine"
+ , property $ \p s -> P.combine p s == LP.combine p s
+ )
+ ,
+ ( "splitPath"
+ , property $ \p -> P.splitPath p == LP.splitPath p
+ )
+ ,
+ ( "joinPath"
+ , property $ \p -> P.joinPath p == LP.joinPath p
+ )
+ ,
+ ( "splitDirectories"
+ , property $ \p -> P.splitDirectories p == LP.splitDirectories p
+ )
+ ,
+ ( "splitDirectories"
+ , property $ \p -> P.splitDirectories p == LP.splitDirectories p
+ )
+ ,
+ ( "splitDrive"
+ , property $ \p -> P.splitDrive p == LP.splitDrive p
+ )
+ ,
+ ( "joinDrive"
+ , property $ \p s -> P.joinDrive p s == LP.joinDrive p s
+ )
+ ,
+ ( "takeDrive"
+ , property $ \p -> P.takeDrive p == LP.takeDrive p
+ )
+ ,
+ ( "hasDrive"
+ , property $ \p -> P.hasDrive p == LP.hasDrive p
+ )
+ ,
+ ( "dropDrive"
+ , property $ \p -> P.dropDrive p == LP.dropDrive p
+ )
+ ,
+ ( "isDrive"
+ , property $ \p -> P.isDrive p == LP.isDrive p
+ )
+ ,
+ ( "hasTrailingPathSeparator"
+ , property $ \p -> P.hasTrailingPathSeparator p == LP.hasTrailingPathSeparator p
+ )
+ ,
+ ( "addTrailingPathSeparator"
+ , property $ \p -> P.addTrailingPathSeparator p == LP.addTrailingPathSeparator p
+ )
+ ,
+ ( "dropTrailingPathSeparator"
+ , property $ \p -> P.dropTrailingPathSeparator p == LP.dropTrailingPathSeparator p
+ )
+ ,
+ ( "normalise"
+ , property $ \p -> P.normalise p == LP.normalise p
+ )
+ ,
+ ( "equalFilePath"
+ , property $ \p s -> P.equalFilePath p s == LP.equalFilePath p s
+ )
+ ,
+ ( "makeRelative"
+ , property $ \p s -> P.makeRelative p s == LP.makeRelative p s
+ )
+ ,
+ ( "isRelative"
+ , property $ \p -> P.isRelative p == LP.isRelative p
+ )
+ ,
+ ( "isAbsolute"
+ , property $ \p -> P.isAbsolute p == LP.isAbsolute p
+ )
+ ,
+ ( "isValid"
+ , property $ \p -> P.isValid p == LP.isValid p
+ )
+ ,
+ ( "makeValid"
+ , property $ \p -> P.makeValid p == LP.makeValid p
+ )
+ ]
]
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/filepath-tests/Test.hs b/tests/filepath-tests/Test.hs
index 75d50494afc21b94d49a2e523c39c07c4900ea0d..cdcffd27bb541d2e167f68eb0c8125fedde88237 100755
--- a/tests/filepath-tests/Test.hs
+++ b/tests/filepath-tests/Test.hs
@@ -1,39 +1,9 @@
-{-# LANGUAGE TypeApplications #-}
-
module Main where
-import System.Environment
-import TestGen
-import Control.Monad
-import Data.Maybe
-import Test.QuickCheck
-
+import TestGen (tests)
+import Test.Tasty
+import Test.Tasty.QuickCheck
main :: IO ()
-main = do
- args <- getArgs
- let count = case args of i:_ -> read i; _ -> 10000
- let testNum = case args of
- _:i:_
- | let num = read i
- , num < 0 -> drop (negate num) tests
- | let num = read i
- , num > 0 -> take num tests
- | otherwise -> []
- _ -> tests
- putStrLn $ "Testing with " ++ show count ++ " repetitions"
- let total' = length testNum
- let showOutput x = show x{output=""} ++ "\n" ++ output x
- bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do
- putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg
- res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
- case res of
- Success{} -> pure Nothing
- bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad)
- if null bad then
- putStrLn $ "Success, " ++ show total' ++ " tests passed"
- else do
- putStrLn $ show (length bad) ++ " FAILURES\n"
- forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) ->
- putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
- fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"
+main = defaultMain $ testProperties "doctests" tests
+