From 87e6aff07ef6968535126d93e45b54392deb64fa Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 27 Jan 2024 17:27:37 +0800
Subject: [PATCH 1/3] Improve equivalence tests

Better generator distribution.
---
 filepath.cabal                               |   1 +
 tests/filepath-equivalent-tests/Gen.hs       | 200 ++++
 tests/filepath-equivalent-tests/TestEquiv.hs | 972 ++++++++-----------
 3 files changed, 605 insertions(+), 568 deletions(-)
 create mode 100644 tests/filepath-equivalent-tests/Gen.hs

diff --git a/filepath.cabal b/filepath.cabal
index 3f9d0e30..5ba88ab5 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -133,6 +133,7 @@ test-suite filepath-equivalent-tests
     Legacy.System.FilePath.Posix
     Legacy.System.FilePath.Windows
     TestUtil
+    Gen
 
   build-depends:
     , base
diff --git a/tests/filepath-equivalent-tests/Gen.hs b/tests/filepath-equivalent-tests/Gen.hs
new file mode 100644
index 00000000..309ffecf
--- /dev/null
+++ b/tests/filepath-equivalent-tests/Gen.hs
@@ -0,0 +1,200 @@
+{-# 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
+  arbitrary = do
+    ns <- arbitrary
+    ds <- arbitrary
+    i <- chooseInt (0, 100)
+    if i >= 50
+    then do
+           ns' <- arbitrary
+           pure $ FileName (ns <> NonEmptyString ('.':|[]) <> ns') ds
+    else pure $ FileName ns ds
+  shrink = genericShrink
+
+
+instance Arbitrary (Maybe DataStream) where
+  arbitrary = genericArbitraryRec (1 % 1 % ())
+  shrink = genericShrink
+
+instance AltShow FileName where
+  altShow (FileName ns ds) = altShow ns ++ altShow ds
+
+--  stream = ":" 1*schar [ ":" 1*schar ] / ":" ":" 1*schar
+data DataStream = DS1 NonEmptyString (Maybe NonEmptyString)
+                | DS2 NonEmptyString -- ::datatype
+  deriving (GShow, Show, Eq, Ord, Generic)
+  deriving Arbitrary via (GenericArbitraryRec '[1, 1] `AndShrinking` DataStream)
+
+instance AltShow DataStream where
+  altShow (DS1 ns Nothing) = ":" ++ altShow ns
+  altShow (DS1 ns (Just ns2)) = ":" ++ altShow ns ++ ":" ++ altShow ns2
+  altShow (DS2 ns) = "::" ++ altShow ns
+
+instance Arbitrary WindowsFilePaths where
+  arbitrary = WindowsFilePaths <$> listOf' arbitrary
+  shrink = genericShrink
+
+instance Arbitrary [Separator] where
+  arbitrary = listOf' arbitrary
+  shrink = genericShrink
+
+instance Arbitrary a => Arbitrary (NonEmpty a) where
+  arbitrary = NE.fromList <$> listOf1' arbitrary
+  shrink = genericShrink
+
diff --git a/tests/filepath-equivalent-tests/TestEquiv.hs b/tests/filepath-equivalent-tests/TestEquiv.hs
index 4405ea40..99ab99a9 100644
--- a/tests/filepath-equivalent-tests/TestEquiv.hs
+++ b/tests/filepath-equivalent-tests/TestEquiv.hs
@@ -1,12 +1,9 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingVia, TypeOperators #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Main where
@@ -16,584 +13,423 @@ import Test.Tasty.QuickCheck hiding ((==>))
 import TestUtil
 import Prelude as P
 import Data.Char (isAsciiLower, isAsciiUpper)
-import Data.List.NonEmpty (NonEmpty(..))
-import Generic.Random
-import Generics.Deriving.Show
-import GHC.Generics
+import Gen
 
 import qualified System.FilePath.Windows as W
 import qualified System.FilePath.Posix as P
 import qualified Legacy.System.FilePath.Windows as LW
 import qualified Legacy.System.FilePath.Posix as LP
-import qualified Data.List.NonEmpty as NE
 
 
-class AltShow a where
-  altShow :: a -> String
-
-instance {-# OVERLAPPABLE #-} Show a => AltShow a where
-  altShow = show
-
-instance {-# OVERLAPS #-} AltShow String where
-  altShow = id
-
-instance {-# OVERLAPPABLE #-} AltShow a => AltShow (Maybe a) where
-  altShow Nothing = ""
-  altShow (Just a) = altShow a
-
-
-newtype WindowsFilePaths = WindowsFilePaths { unWindowsFilePaths :: [WindowsFilePath] }
-  deriving (Show, Eq, Ord, Generic)
-
--- filepath = namespace *"\" namespace-tail
---          / UNC
---          / [ disk ] *"\" relative-path
---          / disk *"\"
-data WindowsFilePath = NS NameSpace [Separator] NSTail
-                     | UNC UNCShare
-                     | N (Maybe Char) [Separator] (Maybe RelFilePath)
-                     -- ^ This differs from the grammar, because we allow
-                     -- empty paths
-                     | PotentiallyInvalid FilePath
-                     -- ^ this branch is added purely for the tests
-  deriving (GShow, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` WindowsFilePath)
-
-instance Show WindowsFilePath where
-  show wf = gshow wf ++ " (" ++ altShow wf ++ ")"
-
-instance AltShow WindowsFilePath where
-  altShow (NS ns seps nstail) = altShow ns ++ altShow seps ++ altShow nstail
-  altShow (UNC unc) = altShow unc
-  altShow (N mdisk seps mfrp) = maybe [] (:[]) mdisk ++ (altShow seps ++ maybe "" altShow mfrp)
-  altShow (PotentiallyInvalid fp) = fp
-
-
--- namespace-tail     = ( disk 1*"\" relative-path ; C:foo\bar is not valid
---                                                 ; namespaced paths are all absolute
---                      / disk *"\"
---                      / relative-path
---                      )
-data NSTail = NST1 Char (NonEmpty Separator) RelFilePath
-            | NST2 Char [Separator]
-            | NST3 RelFilePath
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` NSTail)
-
-instance AltShow NSTail where
-  altShow (NST1 disk seps relfp) = disk:':':(altShow seps ++ altShow relfp)
-  altShow (NST2 disk seps) = disk:':':altShow seps
-  altShow (NST3 relfp) = altShow relfp
-
-
---  UNC = "\\" 1*pchar "\" 1*pchar  [ 1*"\" [ relative-path ] ]
-data UNCShare = UNCShare Separator Separator
-                         NonEmptyString
-                         (NonEmpty Separator)
-                         NonEmptyString
-                         (Maybe (NonEmpty Separator, Maybe RelFilePath))
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` UNCShare)
-
-instance AltShow UNCShare where
-  altShow (UNCShare sep1 sep2 fp1 seps fp2 mrfp) = altShow sep1 ++ altShow sep2 ++ altShow fp1 ++ altShow seps ++ altShow fp2 ++ maybe "" (\(a, b) -> altShow a ++ maybe "" altShow b) mrfp
-
-newtype NonEmptyString = NonEmptyString (NonEmpty Char)
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` NonEmptyString)
-
-instance AltShow NonEmptyString where
-  altShow (NonEmptyString ns) = NE.toList ns
-
-
--- | Windows API Namespaces
---
--- https://docs.microsoft.com/en-us/windows/win32/fileio/naming-a-file#namespaces
--- https://support.microsoft.com/en-us/topic/70b92942-a643-2f2d-2ac6-aad8acad49fb
--- https://superuser.com/a/1096784/854039
--- https://reverseengineering.stackexchange.com/a/15178
--- https://stackoverflow.com/a/25099634
---
--- namespace          = file-namespace / device-namespace / nt-namespace
--- file-namespace     = "\" "\" "?" "\"
--- device-namespace   = "\" "\" "." "\"
--- nt-namespace       = "\" "?" "?" "\"
-data NameSpace = FileNameSpace
-               | DeviceNameSpace
-               | NTNameSpace
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` NameSpace)
-
-instance AltShow NameSpace where
-  altShow FileNameSpace = "\\\\?\\"
-  altShow DeviceNameSpace = "\\\\.\\"
-  altShow NTNameSpace = "\\??\\"
-
-
-data Separator = UnixSep
-               | WindowsSep
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` Separator)
-
-instance AltShow Separator where
-  altShow UnixSep = "/"
-  altShow WindowsSep = "\\"
-
-instance {-# OVERLAPS #-} AltShow (NonEmpty Separator) where
-  altShow ne = mconcat $ NE.toList (altShow <$> ne)
-
-instance {-# OVERLAPS #-} AltShow [Separator] where
-  altShow [] = ""
-  altShow ne = altShow (NE.fromList ne)
-
---  relative-path = 1*(path-name 1*"\") [ file-name ] / file-name
-data RelFilePath = Rel1 (NonEmpty (NonEmptyString, NonEmpty Separator)) (Maybe FileName)
-                 | Rel2 FileName
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` RelFilePath)
-
-instance AltShow RelFilePath where
-  altShow (Rel1 ns mf) = (mconcat $ NE.toList $ fmap (\(a, b) -> altShow a ++ altShow b) ns) ++ maybe "" altShow mf
-  altShow (Rel2 fn) = altShow fn
-
---  file-name = 1*pchar [ stream ]
-data FileName = FileName NonEmptyString (Maybe DataStream)
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` FileName)
-
-instance AltShow FileName where
-  altShow (FileName ns ds) = altShow ns ++ altShow ds
-
---  stream = ":" 1*schar [ ":" 1*schar ] / ":" ":" 1*schar
-data DataStream = DS1 NonEmptyString (Maybe NonEmptyString)
-                | DS2 NonEmptyString -- ::datatype
-  deriving (GShow, Show, Eq, Ord, Generic)
-  deriving Arbitrary via (GenericArbitraryU `AndShrinking` DataStream)
-
-instance AltShow DataStream where
-  altShow (DS1 ns Nothing) = ":" ++ altShow ns
-  altShow (DS1 ns (Just ns2)) = ":" ++ altShow ns ++ ":" ++ altShow ns2
-  altShow (DS2 ns) = "::" ++ altShow ns
-
-instance Arbitrary WindowsFilePaths where
-  arbitrary = scale (`mod` 20) $ genericArbitrary uniform
-
-instance Arbitrary [Separator] where
-  arbitrary = scale (`mod` 20) $ genericArbitrary uniform
-
-instance Arbitrary a => Arbitrary (NonEmpty a) where
-  arbitrary = scale (`mod` 20) $ do
-    x <- arbitrary
-    case x of
-      [] -> (NE.fromList . (:[])) <$> arbitrary
-      xs -> pure (NE.fromList xs)
-
 
 main :: IO ()
 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
+      )
+    ]
   ]
 
 

From 56aba32edf6765ea7d328dd5febd0167d926ec39 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 27 Jan 2024 18:07:12 +0800
Subject: [PATCH 2/3] Migrate abstract-filepath-tests to tasty

---
 filepath.cabal                               |   2 +
 tests/abstract-filepath/OsPathSpec.hs        | 409 ++++++++++---------
 tests/abstract-filepath/Test.hs              |   4 +-
 tests/filepath-equivalent-tests/Gen.hs       |   4 +-
 tests/filepath-equivalent-tests/TestEquiv.hs |  13 -
 5 files changed, 215 insertions(+), 217 deletions(-)

diff --git a/filepath.cabal b/filepath.cabal
index 5ba88ab5..d9ff661c 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -165,6 +165,8 @@ test-suite abstract-filepath
     , os-string   >=2.0.1
     , QuickCheck  >=2.7      && <2.15
     , quickcheck-classes-base ^>=0.6.2
+    , tasty
+    , tasty-quickcheck
 
 benchmark bench-filepath
   default-language: Haskell2010
diff --git a/tests/abstract-filepath/OsPathSpec.hs b/tests/abstract-filepath/OsPathSpec.hs
index 35bff2ee..2b50607c 100644
--- a/tests/abstract-filepath/OsPathSpec.hs
+++ b/tests/abstract-filepath/OsPathSpec.hs
@@ -33,6 +33,8 @@ import qualified System.OsString.Data.ByteString.Short.Word16 as BS16
 import qualified System.OsString.Data.ByteString.Short as SBS
 import Data.Char ( ord )
 import Data.Proxy ( Proxy(..) )
+import Test.Tasty
+import Test.Tasty.QuickCheck
 
 import Arbitrary
 
@@ -42,211 +44,216 @@ fromRight _ (Right b) = b
 fromRight b _         = b
 
 
-tests :: [(String, Property)]
-tests =
-  [ ("OSP.encodeUtf . OSP.decodeUtf == id",
-    property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str)
+tests :: TestTree
+tests = testGroup "Abstract filepath" [
+    testGroup "filepaths"
+    [ testProperties "OSP"
+      [ ("pack . unpack == id",
+        property $ \ws@(OsString _) ->
+          OSP.pack (OSP.unpack ws) === ws
+        ),
+        ("encodeUtf . decodeUtf == id",
+          property $ \(NonNullString str) -> (OSP.decodeUtf . fromJust . OSP.encodeUtf) str == Just str)
+      ],
+      testProperties "Windows"
+        [ ("pack . unpack == id (Windows)",
+          property $ \ws@(WindowsString _) ->
+          Windows.pack (Windows.unpack ws) === ws
+          )
+        , ("decodeUtf . encodeUtf == id",
+          property $ \(NonNullString str) -> (Windows.decodeUtf . fromJust . Windows.encodeUtf) str == Just str)
+        , ("encodeWith ucs2le . decodeWith ucs2le == id",
+          property $ \(padEven -> bs) -> (Windows.encodeWith ucs2le . (\(Right r) -> r) . Windows.decodeWith ucs2le . OS.WS . toShort) bs
+                 === Right (OS.WS . toShort $ bs))
+        , ("decodeFS . encodeFS == id (Windows)",
+          property $ \(NonNullString str) -> ioProperty $ do
+            r1 <- Windows.encodeFS str
+            r2 <- try @SomeException $ Windows.decodeFS r1
+            r3 <- evaluate $ force $ first displayException r2
+            pure (r3 === Right str)
+            )
+        , ("fromPlatformString* functions are equivalent under ASCII",
+          property $ \(WindowsString . BS16.pack . map (fromIntegral . ord) . nonNullAsciiString -> str) -> ioProperty $ do
+            r1         <- Windows.decodeFS str
+            r2         <- Windows.decodeUtf str
+            (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) str
+            (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) str
+            (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) str
+            pure (    r1 === r2
+                 .&&. r1 === r3
+                 .&&. r1 === r4
+                 .&&. r1 === r5
+                 )
+          )
+        , ("toPlatformString* functions are equivalent under ASCII",
+          property $ \(NonNullAsciiString str) -> ioProperty $ do
+            r1         <- Windows.encodeFS str
+            r2         <- Windows.encodeUtf str
+            (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
+            (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
+            (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
+            pure (    r1 === r2
+                 .&&. r1 === r3
+                 .&&. r1 === r4
+                 .&&. r1 === r5
+                 )
+          )
+        , ("Unit test toPlatformString*",
+          property $ ioProperty $ do
+            let str = "ABcK_(ツ123_&**"
+            let expected = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
+            r1         <-        Windows.encodeFS str
+            r2         <-        Windows.encodeUtf str
+            (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
+            (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
+            (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
+            pure (    r1 === expected
+                 .&&. r2 === expected
+                 .&&. r3 === expected
+                 .&&. r4 === expected
+                 .&&. r5 === expected
+                 )
+          )
+        , ("Unit test fromPlatformString*",
+          property $ ioProperty $ do
+            let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
+            let expected = "ABcK_(ツ123_&**"
+            r1         <-        Windows.decodeFS bs
+            r2         <-        Windows.decodeUtf bs
+            (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) bs
+            (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) bs
+            (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) bs
+            pure (    r1 === expected
+                 .&&. r2 === expected
+                 .&&. r3 === expected
+                 .&&. r4 === expected
+                 .&&. r5 === expected
+                 )
+          )
+        ]
+    , testProperties "Posix"
+      [ ("decodeUtf . encodeUtf == id",
+          property $ \(NonNullString str) -> (Posix.decodeUtf . fromJust . Posix.encodeUtf) str == Just str)
+      , ("encodeWith ucs2le . decodeWith ucs2le == id (Posix)",
+          property $ \(padEven -> bs) -> (Posix.encodeWith ucs2le . (\(Right r) -> r) . Posix.decodeWith ucs2le . OS.PS . toShort) bs === Right (OS.PS . toShort $ bs))
+      , ("decodeFS . encodeFS == id",
+          property $ \(NonNullString str) -> ioProperty $ do
+            setFileSystemEncoding (mkUTF8 TransliterateCodingFailure)
+            r1 <- Posix.encodeFS str
+            r2 <- try @SomeException $ Posix.decodeFS r1
+            r3 <- evaluate $ force $ first displayException r2
+            pure (r3 === Right str)
+            )
+      , ("fromPlatformString* functions are equivalent under ASCII",
+          property $ \(PosixString . SBS.toShort . C.pack . nonNullAsciiString -> str) -> ioProperty $ do
+            r1         <-        Posix.decodeFS str
+            r2         <-        Posix.decodeUtf str
+            (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) str
+            (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) str
+            (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) str
+            pure (    r1 === r2
+                 .&&. r1 === r3
+                 .&&. r1 === r4
+                 .&&. r1 === r5
+                 )
+          )
+      , ("toPlatformString* functions are equivalent under ASCII",
+          property $ \(NonNullAsciiString str) -> ioProperty $ do
+            r1         <-        Posix.encodeFS str
+            r2         <-        Posix.encodeUtf str
+            (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
+            (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
+            (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
+            pure (    r1 === r2
+                 .&&. r1 === r3
+                 .&&. r1 === r4
+                 .&&. r1 === r5
+                 )
+          )
+      , ("Unit test toPlatformString*",
+          property $ ioProperty $ do
+            let str = "ABcK_(ツ123_&**"
+            let expected = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
+            r1         <-        Posix.encodeFS str
+            r2         <-        Posix.encodeUtf str
+            (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
+            (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
+            (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
+            pure (    r1 === expected
+                 .&&. r2 === expected
+                 .&&. r3 === expected
+                 .&&. r4 === expected
+                 .&&. r5 === expected
+                 )
+          )
+      , ("Unit test fromPlatformString*",
+          property $ ioProperty $ do
+            let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
+            let expected = "ABcK_(ツ123_&**"
+            r1         <-        Posix.decodeFS bs
+            r2         <-        Posix.decodeUtf bs
+            (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) bs
+            (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) bs
+            (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) bs
+            pure (    r1 === expected
+                 .&&. r2 === expected
+                 .&&. r3 === expected
+                 .&&. r4 === expected
+                 .&&. r5 === expected
+                 )
+          )
+      , ("pack . unpack == id (Posix)",
+          property $ \ws@(PosixString _) ->
+            Posix.pack (Posix.unpack ws) === ws
+          )
+      ]
+    ],
+  testGroup "QuasiQuoter"
+    [ testProperties "windows"
+      [ ("QuasiQuoter (WindowsPath)",
+        property $ do
+          let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f]
+          let expected = [Windows.pstr|ABcK_|]
+          bs === expected
+        )
+      , ("QuasiQuoter (WindowsString)",
+        property $ do
+          let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
+          let expected = [WindowsS.pstr|ABcK_(ツ123_&**|]
+          bs === expected
+        )
+       ],
+       testProperties "posix"
+       [ ("QuasiQuoter (PosixPath)",
+         property $ do
+           let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f]
+           let expected = [Posix.pstr|ABcK_|]
+           bs === expected
+         )
+       , ("QuasiQuoter (PosixString)",
+          property $ do
+            let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
+            let expected = [PosixS.pstr|ABcK_(ツ123_&**|]
+            bs === expected
+          )
+       ]
+    ],
+   testProperties "Type laws"
+     (QC.lawsProperties (QC.ordLaws (Proxy @OsPath))
+      ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsPath))
 
-  , ("decodeUtf . encodeUtf == id (Posix)",
-    property $ \(NonNullString str) -> (Posix.decodeUtf . fromJust . Posix.encodeUtf) str == Just str)
-  , ("decodeUtf . encodeUtf == id (Windows)",
-    property $ \(NonNullString str) -> (Windows.decodeUtf . fromJust . Windows.encodeUtf) str == Just str)
+      ++ QC.lawsProperties (QC.ordLaws (Proxy @OsString))
+      ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsString))
 
-  , ("encodeWith ucs2le . decodeWith ucs2le == id (Posix)",
-    property $ \(padEven -> bs) -> (Posix.encodeWith ucs2le . (\(Right r) -> r) . Posix.decodeWith ucs2le . OS.PS . toShort) bs === Right (OS.PS . toShort $ bs))
-  , ("encodeWith ucs2le . decodeWith ucs2le == id (Windows)",
-    property $ \(padEven -> bs) -> (Windows.encodeWith ucs2le . (\(Right r) -> r) . Windows.decodeWith ucs2le . OS.WS . toShort) bs
-           === Right (OS.WS . toShort $ bs))
+      ++ QC.lawsProperties (QC.ordLaws (Proxy @WindowsString))
+      ++ QC.lawsProperties (QC.monoidLaws (Proxy @WindowsString))
 
-  , ("decodeFS . encodeFS == id (Posix)",
-    property $ \(NonNullString str) -> ioProperty $ do
-      setFileSystemEncoding (mkUTF8 TransliterateCodingFailure)
-      r1 <- Posix.encodeFS str
-      r2 <- try @SomeException $ Posix.decodeFS r1
-      r3 <- evaluate $ force $ first displayException r2
-      pure (r3 === Right str)
-      )
-  , ("decodeFS . encodeFS == id (Windows)",
-    property $ \(NonNullString str) -> ioProperty $ do
-      r1 <- Windows.encodeFS str
-      r2 <- try @SomeException $ Windows.decodeFS r1
-      r3 <- evaluate $ force $ first displayException r2
-      pure (r3 === Right str)
-      )
+      ++ QC.lawsProperties (QC.ordLaws (Proxy @PosixString))
+      ++ QC.lawsProperties (QC.monoidLaws (Proxy @PosixString))
 
-  , ("fromPlatformString* functions are equivalent under ASCII (Windows)",
-    property $ \(WindowsString . BS16.pack . map (fromIntegral . ord) . nonNullAsciiString -> str) -> ioProperty $ do
-      r1         <- Windows.decodeFS str
-      r2         <- Windows.decodeUtf str
-      (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) str
-      (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) str
-      (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) str
-      pure (    r1 === r2
-           .&&. r1 === r3
-           .&&. r1 === r4
-           .&&. r1 === r5
-           )
-    )
-
-  , ("fromPlatformString* functions are equivalent under ASCII (Posix)",
-    property $ \(PosixString . SBS.toShort . C.pack . nonNullAsciiString -> str) -> ioProperty $ do
-      r1         <-        Posix.decodeFS str
-      r2         <-        Posix.decodeUtf str
-      (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) str
-      (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) str
-      (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) str
-      pure (    r1 === r2
-           .&&. r1 === r3
-           .&&. r1 === r4
-           .&&. r1 === r5
-           )
-    )
-
-  , ("toPlatformString* functions are equivalent under ASCII (Windows)",
-    property $ \(NonNullAsciiString str) -> ioProperty $ do
-      r1         <- Windows.encodeFS str
-      r2         <- Windows.encodeUtf str
-      (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
-      (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
-      (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
-      pure (    r1 === r2
-           .&&. r1 === r3
-           .&&. r1 === r4
-           .&&. r1 === r5
-           )
-    )
-
-  , ("toPlatformString* functions are equivalent under ASCII (Posix)",
-    property $ \(NonNullAsciiString str) -> ioProperty $ do
-      r1         <-        Posix.encodeFS str
-      r2         <-        Posix.encodeUtf str
-      (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
-      (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
-      (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
-      pure (    r1 === r2
-           .&&. r1 === r3
-           .&&. r1 === r4
-           .&&. r1 === r5
-           )
-    )
-  , ("Unit test toPlatformString* (Posix)",
-    property $ ioProperty $ do
-      let str = "ABcK_(ツ123_&**"
-      let expected = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
-      r1         <-        Posix.encodeFS str
-      r2         <-        Posix.encodeUtf str
-      (Right r3) <- pure $ Posix.encodeWith (mkUTF8 TransliterateCodingFailure) str
-      (Right r4) <- pure $ Posix.encodeWith (mkUTF8 RoundtripFailure) str
-      (Right r5) <- pure $ Posix.encodeWith (mkUTF8 ErrorOnCodingFailure) str
-      pure (    r1 === expected
-           .&&. r2 === expected
-           .&&. r3 === expected
-           .&&. r4 === expected
-           .&&. r5 === expected
-           )
-    )
-  , ("Unit test toPlatformString* (WindowsString)",
-    property $ ioProperty $ do
-      let str = "ABcK_(ツ123_&**"
-      let expected = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
-      r1         <-        Windows.encodeFS str
-      r2         <-        Windows.encodeUtf str
-      (Right r3) <- pure $ Windows.encodeWith (mkUTF16le TransliterateCodingFailure) str
-      (Right r4) <- pure $ Windows.encodeWith (mkUTF16le RoundtripFailure) str
-      (Right r5) <- pure $ Windows.encodeWith (mkUTF16le ErrorOnCodingFailure) str
-      pure (    r1 === expected
-           .&&. r2 === expected
-           .&&. r3 === expected
-           .&&. r4 === expected
-           .&&. r5 === expected
-           )
-    )
-
-  , ("Unit test fromPlatformString* (Posix)",
-    property $ ioProperty $ do
-      let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
-      let expected = "ABcK_(ツ123_&**"
-      r1         <-        Posix.decodeFS bs
-      r2         <-        Posix.decodeUtf bs
-      (Right r3) <- pure $ Posix.decodeWith (mkUTF8 TransliterateCodingFailure) bs
-      (Right r4) <- pure $ Posix.decodeWith (mkUTF8 RoundtripFailure) bs
-      (Right r5) <- pure $ Posix.decodeWith (mkUTF8 ErrorOnCodingFailure) bs
-      pure (    r1 === expected
-           .&&. r2 === expected
-           .&&. r3 === expected
-           .&&. r4 === expected
-           .&&. r5 === expected
-           )
-    )
-  , ("Unit test fromPlatformString* (WindowsString)",
-    property $ ioProperty $ do
-      let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
-      let expected = "ABcK_(ツ123_&**"
-      r1         <-        Windows.decodeFS bs
-      r2         <-        Windows.decodeUtf bs
-      (Right r3) <- pure $ Windows.decodeWith (mkUTF16le TransliterateCodingFailure) bs
-      (Right r4) <- pure $ Windows.decodeWith (mkUTF16le RoundtripFailure) bs
-      (Right r5) <- pure $ Windows.decodeWith (mkUTF16le ErrorOnCodingFailure) bs
-      pure (    r1 === expected
-           .&&. r2 === expected
-           .&&. r3 === expected
-           .&&. r4 === expected
-           .&&. r5 === expected
-           )
-    )
-  , ("QuasiQuoter (WindowsString)",
-    property $ do
-      let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f,0x0028,0x30c4,0x0031,0x0032,0x0033,0x005f,0x0026,0x002a,0x002a]
-      let expected = [WindowsS.pstr|ABcK_(ツ123_&**|]
-      bs === expected
-    )
-  , ("QuasiQuoter (PosixString)",
-    property $ do
-      let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f,0x28,0xe3,0x83,0x84,0x31,0x32,0x33,0x5f,0x26,0x2a,0x2a]
-      let expected = [PosixS.pstr|ABcK_(ツ123_&**|]
-      bs === expected
-    )
-  , ("QuasiQuoter (WindowsPath)",
-    property $ do
-      let bs = WindowsString $ BS16.pack [0x0041,0x0042,0x0063,0x004b,0x005f]
-      let expected = [Windows.pstr|ABcK_|]
-      bs === expected
-    )
-  , ("QuasiQuoter (PosixPath)",
-    property $ do
-      let bs = PosixString $ SBS.pack [0x41,0x42,0x63,0x4b,0x5f]
-      let expected = [Posix.pstr|ABcK_|]
-      bs === expected
-    )
-
-  , ("pack . unpack == id (Windows)",
-    property $ \ws@(WindowsString _) ->
-      Windows.pack (Windows.unpack ws) === ws
-    )
-  , ("pack . unpack == id (Posix)",
-    property $ \ws@(PosixString _) ->
-      Posix.pack (Posix.unpack ws) === ws
-    )
-  , ("pack . unpack == id (OsPath)",
-    property $ \ws@(OsString _) ->
-      OSP.pack (OSP.unpack ws) === ws
-    )
-
-
-  ] ++ QC.lawsProperties (QC.ordLaws (Proxy @OsPath))
-    ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsPath))
-
-    ++ QC.lawsProperties (QC.ordLaws (Proxy @OsString))
-    ++ QC.lawsProperties (QC.monoidLaws (Proxy @OsString))
-
-    ++ QC.lawsProperties (QC.ordLaws (Proxy @WindowsString))
-    ++ QC.lawsProperties (QC.monoidLaws (Proxy @WindowsString))
-
-    ++ QC.lawsProperties (QC.ordLaws (Proxy @PosixString))
-    ++ QC.lawsProperties (QC.monoidLaws (Proxy @PosixString))
-
-    ++ QC.lawsProperties (QC.ordLaws (Proxy @PlatformString))
-    ++ QC.lawsProperties (QC.monoidLaws (Proxy @PlatformString))
+      ++ QC.lawsProperties (QC.ordLaws (Proxy @PlatformString))
+      ++ QC.lawsProperties (QC.monoidLaws (Proxy @PlatformString)))
+  ]
 
 
 padEven :: ByteString -> ByteString
diff --git a/tests/abstract-filepath/Test.hs b/tests/abstract-filepath/Test.hs
index 00261b0e..31698b6b 100644
--- a/tests/abstract-filepath/Test.hs
+++ b/tests/abstract-filepath/Test.hs
@@ -1,7 +1,7 @@
 module Main (main) where
 
 import qualified OsPathSpec
-import TestUtil
+import Test.Tasty
 
 main :: IO ()
-main = runTests (OsPathSpec.tests)
+main = defaultMain OsPathSpec.tests
diff --git a/tests/filepath-equivalent-tests/Gen.hs b/tests/filepath-equivalent-tests/Gen.hs
index 309ffecf..97aa358a 100644
--- a/tests/filepath-equivalent-tests/Gen.hs
+++ b/tests/filepath-equivalent-tests/Gen.hs
@@ -148,7 +148,7 @@ data RelFilePath = Rel1 (NonEmpty (NonEmptyString, NonEmpty Separator)) (Maybe F
   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 (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 ]
@@ -156,6 +156,8 @@ 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
diff --git a/tests/filepath-equivalent-tests/TestEquiv.hs b/tests/filepath-equivalent-tests/TestEquiv.hs
index 99ab99a9..339ce1ac 100644
--- a/tests/filepath-equivalent-tests/TestEquiv.hs
+++ b/tests/filepath-equivalent-tests/TestEquiv.hs
@@ -21,7 +21,6 @@ import qualified Legacy.System.FilePath.Windows as LW
 import qualified Legacy.System.FilePath.Posix as LP
 
 
-
 main :: IO ()
 main = defaultMain equivalentTests
 
@@ -432,15 +431,3 @@ equivalentTests = testGroup "equivalence"
     ]
   ]
 
-
-
-
-
-
-
-
-
-
-
-
-

From d651a599766faa2f18d42f90f7eb1d0c4c2326f3 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 27 Jan 2024 18:16:25 +0800
Subject: [PATCH 3/3] Migrate rest to tasty

---
 filepath.cabal                        |  5 ++--
 tests/TestUtil.hs                     | 33 ++--------------------
 tests/abstract-filepath/Arbitrary.hs  |  2 +-
 tests/abstract-filepath/OsPathSpec.hs |  1 -
 tests/filepath-tests/Test.hs          | 40 ++++-----------------------
 5 files changed, 10 insertions(+), 71 deletions(-)

diff --git a/filepath.cabal b/filepath.cabal
index d9ff661c..1fe1da50 100644
--- a/filepath.cabal
+++ b/filepath.cabal
@@ -117,7 +117,8 @@ test-suite filepath-tests
     , bytestring  >=0.11.3.0
     , filepath
     , os-string   >=2.0.1
-    , QuickCheck  >=2.7      && <2.15
+    , tasty
+    , tasty-quickcheck
 
   default-language: Haskell2010
   ghc-options:      -Wall
@@ -142,7 +143,6 @@ test-suite filepath-equivalent-tests
     , generic-random
     , generic-deriving
     , os-string   >=2.0.1
-    , QuickCheck  >=2.7      && <2.15
     , tasty
     , tasty-quickcheck
 
@@ -163,7 +163,6 @@ test-suite abstract-filepath
     , deepseq
     , filepath
     , os-string   >=2.0.1
-    , QuickCheck  >=2.7      && <2.15
     , quickcheck-classes-base ^>=0.6.2
     , tasty
     , tasty-quickcheck
diff --git a/tests/TestUtil.hs b/tests/TestUtil.hs
index 8365c930..f238f10e 100644
--- a/tests/TestUtil.hs
+++ b/tests/TestUtil.hs
@@ -4,12 +4,12 @@
 
 module TestUtil(
     module TestUtil,
-    module Test.QuickCheck,
+    module Test.Tasty.QuickCheck,
     module Data.List,
     module Data.Maybe
     ) where
 
-import Test.QuickCheck hiding ((==>))
+import Test.Tasty.QuickCheck hiding ((==>))
 import Data.ByteString.Short (ShortByteString)
 import Data.List
 import Data.Maybe
@@ -29,7 +29,6 @@ import System.OsString.Encoding.Internal
 import GHC.IO.Encoding.UTF16 ( mkUTF16le )
 import GHC.IO.Encoding.UTF8 ( mkUTF8 )
 import GHC.IO.Encoding.Failure
-import System.Environment
 
 
 infixr 0 ==>
@@ -158,31 +157,3 @@ instance Arbitrary PosixChar where
   arbitrary = PW <$> arbitrary
 #endif
 
-runTests :: [(String, Property)] -> IO ()
-runTests tests = do
-    args <- getArgs
-    let count   = case args of i:_   -> read i; _ -> 10000
-    let testNum = case args of
-                    _:i:_
-                      | let num = read i
-                      , num < 0    -> drop (negate num) tests
-                      | let num = read i
-                      , num > 0    -> take num          tests
-                      | otherwise  -> []
-                    _ -> tests
-    putStrLn $ "Testing with " ++ show count ++ " repetitions"
-    let total' = length testNum
-    let showOutput x = show x{output=""} ++ "\n" ++ output x
-    bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do
-        putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg
-        res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
-        case res of
-            Success{} -> pure Nothing
-            bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad)
-    if null bad then
-        putStrLn $ "Success, " ++ show total' ++ " tests passed"
-     else do
-        putStrLn $ show (length bad) ++ " FAILURES\n"
-        forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) ->
-            putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
-        fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"
diff --git a/tests/abstract-filepath/Arbitrary.hs b/tests/abstract-filepath/Arbitrary.hs
index 7918eb16..57535234 100644
--- a/tests/abstract-filepath/Arbitrary.hs
+++ b/tests/abstract-filepath/Arbitrary.hs
@@ -10,7 +10,7 @@ import qualified System.OsString.Posix as Posix
 import qualified System.OsString.Windows as Windows
 import Data.ByteString ( ByteString )
 import qualified Data.ByteString as ByteString
-import Test.QuickCheck
+import Test.Tasty.QuickCheck
 
 
 instance Arbitrary OsString where
diff --git a/tests/abstract-filepath/OsPathSpec.hs b/tests/abstract-filepath/OsPathSpec.hs
index 2b50607c..95b96423 100644
--- a/tests/abstract-filepath/OsPathSpec.hs
+++ b/tests/abstract-filepath/OsPathSpec.hs
@@ -20,7 +20,6 @@ import System.OsString.Windows as WindowsS hiding (map)
 import Control.Exception
 import Data.ByteString ( ByteString )
 import qualified Data.ByteString as BS
-import Test.QuickCheck
 import qualified Test.QuickCheck.Classes.Base as QC
 import GHC.IO.Encoding.UTF8 ( mkUTF8 )
 import GHC.IO.Encoding.UTF16 ( mkUTF16le )
diff --git a/tests/filepath-tests/Test.hs b/tests/filepath-tests/Test.hs
index 75d50494..cdcffd27 100755
--- a/tests/filepath-tests/Test.hs
+++ b/tests/filepath-tests/Test.hs
@@ -1,39 +1,9 @@
-{-# LANGUAGE TypeApplications #-}
-
 module Main where
 
-import System.Environment
-import TestGen
-import Control.Monad
-import Data.Maybe
-import Test.QuickCheck
-
+import TestGen (tests)
+import Test.Tasty
+import Test.Tasty.QuickCheck
 
 main :: IO ()
-main = do
-    args <- getArgs
-    let count   = case args of i:_   -> read i; _ -> 10000
-    let testNum = case args of
-                    _:i:_
-                      | let num = read i
-                      , num < 0    -> drop (negate num) tests
-                      | let num = read i
-                      , num > 0    -> take num          tests
-                      | otherwise  -> []
-                    _ -> tests
-    putStrLn $ "Testing with " ++ show count ++ " repetitions"
-    let total' = length testNum
-    let showOutput x = show x{output=""} ++ "\n" ++ output x
-    bad <- fmap catMaybes $ forM (zip @Integer [1..] testNum) $ \(i,(msg,prop)) -> do
-        putStrLn $ "Test " ++ show i ++ " of " ++ show total' ++ ": " ++ msg
-        res <- quickCheckWithResult stdArgs{chatty=False, maxSuccess=count} prop
-        case res of
-            Success{} -> pure Nothing
-            bad -> do putStrLn $ showOutput bad; putStrLn "TEST FAILURE!"; pure $ Just (msg,bad)
-    if null bad then
-        putStrLn $ "Success, " ++ show total' ++ " tests passed"
-     else do
-        putStrLn $ show (length bad) ++ " FAILURES\n"
-        forM_ (zip @Integer [1..] bad) $ \(i,(a,b)) ->
-            putStrLn $ "FAILURE " ++ show i ++ ": " ++ a ++ "\n" ++ showOutput b ++ "\n"
-        fail $ "FAILURE, failed " ++ show (length bad) ++ " of " ++ show total' ++ " tests"
+main = defaultMain $ testProperties "doctests" tests
+