packages feed

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 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"))