filepath 1.5.2.0 → 1.5.3.0
raw patch · 13 files changed
+876/−871 lines, 13 filesdep −QuickCheckdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies removed: QuickCheck
Dependency ranges changed: base
API changes (from Hackage documentation)
- System.OsPath: data () => OsChar
+ System.OsPath: data OsChar
- System.OsPath: data () => OsString
+ System.OsPath: data OsString
- System.OsPath: decodeFS :: OsPath -> IO FilePath
+ System.OsPath: decodeFS :: OsPath -> IO String
- System.OsPath: encodeFS :: FilePath -> IO OsPath
+ System.OsPath: encodeFS :: String -> IO OsPath
- System.OsPath.Encoding: data () => EncodingException
+ System.OsPath.Encoding: data EncodingException
- System.OsPath.Posix: data () => PosixChar
+ System.OsPath.Posix: data PosixChar
- System.OsPath.Posix: data () => PosixString
+ System.OsPath.Posix: data PosixString
- System.OsPath.Posix: decodeFS :: PosixString -> IO String
+ System.OsPath.Posix: decodeFS :: PosixPath -> IO String
- System.OsPath.Posix: encodeFS :: String -> IO PosixString
+ System.OsPath.Posix: encodeFS :: String -> IO PosixPath
- System.OsPath.Types: data () => OsChar
+ System.OsPath.Types: data OsChar
- System.OsPath.Types: data () => OsString
+ System.OsPath.Types: data OsString
- System.OsPath.Types: data () => PosixChar
+ System.OsPath.Types: data PosixChar
- System.OsPath.Types: data () => PosixString
+ System.OsPath.Types: data PosixString
- System.OsPath.Types: data () => WindowsChar
+ System.OsPath.Types: data WindowsChar
- System.OsPath.Types: data () => WindowsString
+ System.OsPath.Types: data WindowsString
- System.OsPath.Windows: data () => WindowsChar
+ System.OsPath.Windows: data WindowsChar
- System.OsPath.Windows: data () => WindowsString
+ System.OsPath.Windows: data WindowsString
- System.OsPath.Windows: decodeFS :: WindowsString -> IO String
+ System.OsPath.Windows: decodeFS :: WindowsPath -> IO String
- System.OsPath.Windows: encodeFS :: String -> IO WindowsString
+ System.OsPath.Windows: encodeFS :: String -> IO WindowsPath
Files
- System/FilePath/Internal.hs +0/−1
- System/OsPath/Common.hs +36/−8
- System/OsPath/Internal.hs +5/−1
- changelog.md +4/−0
- filepath.cabal +7/−5
- tests/TestUtil.hs +2/−31
- tests/abstract-filepath/Arbitrary.hs +1/−1
- tests/abstract-filepath/OsPathSpec.hs +208/−202
- tests/abstract-filepath/Test.hs +2/−2
- tests/filepath-equivalent-tests/Gen.hs +202/−0
- tests/filepath-equivalent-tests/TestEquiv.hs +404/−581
- tests/filepath-tests/Test.hs +5/−35
- tests/filepath-tests/TestGen.hs +0/−4
System/FilePath/Internal.hs view
@@ -426,7 +426,6 @@ -- > splitExtensions "file.tar.gz" == ("file",".tar.gz") -- > uncurry (<>) (splitExtensions x) == x -- > Valid x => uncurry addExtension (splitExtensions x) == x--- > splitExtensions "file.tar.gz" == ("file",".tar.gz") splitExtensions :: FILEPATH -> (FILEPATH, STRING) splitExtensions x = (a <> c, d) where
System/OsPath/Common.hs view
@@ -44,7 +44,7 @@ , PS.encodeUtf , PS.unsafeEncodeUtf , PS.encodeWith- , PS.encodeFS+ , encodeFS #if defined(WINDOWS) || defined(POSIX) , pstr #else@@ -55,7 +55,7 @@ -- * Filepath deconstruction , PS.decodeUtf , PS.decodeWith- , PS.decodeFS+ , decodeFS , PS.unpack -- * Word construction@@ -115,12 +115,10 @@ , toChar , decodeUtf , decodeWith- , decodeFS , pack , encodeUtf , unsafeEncodeUtf , encodeWith- , encodeFS , unpack ) import Data.Bifunctor ( bimap )@@ -148,12 +146,10 @@ , toChar , decodeUtf , decodeWith- , decodeFS , pack , encodeUtf , unsafeEncodeUtf , encodeWith- , encodeFS , unpack ) import Data.Bifunctor ( bimap )@@ -165,12 +161,10 @@ ( osp , decodeUtf , decodeWith- , decodeFS , pack , encodeUtf , unsafeEncodeUtf , encodeWith- , encodeFS , unpack ) import System.OsPath.Types@@ -187,6 +181,7 @@ ( bimap ) #endif import System.OsString.Internal.Types+import System.OsString.Encoding.Internal ------------------------@@ -1439,3 +1434,36 @@ -- > isAbsolute x == not (isRelative x) isAbsolute :: FILEPATH_NAME -> Bool isAbsolute (OSSTRING_NAME x) = C.isAbsolute x+++-- things not defined in os-string++#ifdef WINDOWS+encodeFS :: String -> IO WindowsPath+encodeFS = fmap WindowsString . encodeWithBaseWindows++decodeFS :: WindowsPath -> IO String+decodeFS (WindowsString x) = decodeWithBaseWindows x+#elif defined(POSIX)+encodeFS :: String -> IO PosixPath+encodeFS = fmap PosixString . encodeWithBasePosix++decodeFS :: PosixPath -> IO String+decodeFS (PosixString x) = decodeWithBasePosix x+#else+encodeFS :: String -> IO OsPath+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+encodeFS = fmap (OsString . WindowsString) . encodeWithBaseWindows+#else+encodeFS = fmap (OsString . PosixString) . encodeWithBasePosix+#endif++decodeFS :: OsPath -> IO String+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+decodeFS (OsString (WindowsString x)) = decodeWithBaseWindows x+#else+decodeFS (OsString (PosixString x)) = decodeWithBasePosix x+#endif++#endif+
System/OsPath/Internal.hs view
@@ -56,8 +56,12 @@ unsafeEncodeUtf = OS.unsafeEncodeUtf -- | Encode a 'FilePath' with the specified encoding.+--+-- Note: on windows, we expect a "wide char" encoding (e.g. UCS-2 or UTF-16). Anything+-- that works with @Word16@ boundaries. Picking an incompatible encoding may crash+-- filepath operations. encodeWith :: TextEncoding -- ^ unix text encoding- -> TextEncoding -- ^ windows text encoding+ -> TextEncoding -- ^ windows text encoding (wide char) -> FilePath -> Either EncodingException OsPath encodeWith = OS.encodeWith
changelog.md view
@@ -2,6 +2,10 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ +## 1.5.3.0 *Jun 2024*++* Adjust for `encodeFS`/`decodedFS` deprecation in os-string+ ## 1.5.2.0 *Jan 2024* * Fix a bug in `[splitFileName](https://github.com/haskell/filepath/issues/219)`
filepath.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: filepath-version: 1.5.2.0+version: 1.5.3.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause@@ -91,7 +91,7 @@ default-language: Haskell2010 build-depends:- , base >=4.12.0.0 && <4.20+ , base >=4.12.0.0 && <4.21 , bytestring >=0.11.3.0 , deepseq , exceptions@@ -117,7 +117,8 @@ , 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 @@ Legacy.System.FilePath.Posix Legacy.System.FilePath.Windows TestUtil+ Gen build-depends: , base@@ -141,7 +143,6 @@ , generic-random , generic-deriving , os-string >=2.0.1- , QuickCheck >=2.7 && <2.15 , tasty , tasty-quickcheck @@ -162,8 +163,9 @@ , 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
tests/TestUtil.hs view
@@ -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 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 @@ 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"
tests/abstract-filepath/Arbitrary.hs view
@@ -10,7 +10,7 @@ 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
tests/abstract-filepath/OsPathSpec.hs view
@@ -20,7 +20,6 @@ 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 as SBS import Data.Char ( ord ) import Data.Proxy ( Proxy(..) )+import Test.Tasty+import Test.Tasty.QuickCheck import Arbitrary @@ -42,211 +43,216 @@ fromRight b _ = b -tests :: [(String, Property)]-tests =- [ ("OSP.encodeUtf . OSP.decodeUtf == id",- property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str)-- , ("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)-- , ("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))-- , ("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)- )-- , ("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))+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)) - ++ QC.lawsProperties (QC.ordLaws (Proxy @OsString))- ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsString))+ ++ 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 @WindowsString))+ ++ QC.lawsProperties (QC.monoidLaws (Proxy @WindowsString)) - ++ QC.lawsProperties (QC.ordLaws (Proxy @PosixString))- ++ QC.lawsProperties (QC.monoidLaws (Proxy @PosixString))+ ++ 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
tests/abstract-filepath/Test.hs view
@@ -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
+ tests/filepath-equivalent-tests/Gen.hs view
@@ -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+
tests/filepath-equivalent-tests/TestEquiv.hs view
@@ -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,595 +13,421 @@ 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 () 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+ )+ ] ]------------
tests/filepath-tests/Test.hs view
@@ -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+
tests/filepath-tests/TestGen.hs view
@@ -312,10 +312,6 @@ ,("uncurry W.addExtension (W.splitExtensions x) == x", property $ \(QFilePathValidW x) -> uncurry W.addExtension (W.splitExtensions x) == x) ,("uncurry AFP_P.addExtension (AFP_P.splitExtensions x) == x", property $ \(QFilePathValidAFP_P x) -> uncurry AFP_P.addExtension (AFP_P.splitExtensions x) == x) ,("uncurry AFP_W.addExtension (AFP_W.splitExtensions x) == x", property $ \(QFilePathValidAFP_W x) -> uncurry AFP_W.addExtension (AFP_W.splitExtensions x) == x)- ,("P.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ P.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))- ,("W.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", property $ W.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))- ,("AFP_P.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_P.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz")))- ,("AFP_W.splitExtensions (\"file.tar.gz\") == ((\"file\"), (\".tar.gz\"))", property $ AFP_W.splitExtensions ("file.tar.gz") == (("file"), (".tar.gz"))) ,("P.dropExtensions \"/directory/path.ext\" == \"/directory/path\"", property $ P.dropExtensions "/directory/path.ext" == "/directory/path") ,("W.dropExtensions \"/directory/path.ext\" == \"/directory/path\"", property $ W.dropExtensions "/directory/path.ext" == "/directory/path") ,("AFP_P.dropExtensions (\"/directory/path.ext\") == (\"/directory/path\")", property $ AFP_P.dropExtensions ("/directory/path.ext") == ("/directory/path"))