filepath 1.5.0.0 → 1.5.5.0
raw patch · 16 files changed
Files
- System/FilePath/Internal.hs +56/−15
- System/OsPath/Common.hs +58/−12
- System/OsPath/Internal.hs +49/−13
- System/OsPath/Posix.hs +14/−4
- System/OsPath/Windows.hs +13/−5
- changelog.md +19/−0
- filepath.cabal +32/−18
- tests/TestUtil.hs +2/−31
- tests/abstract-filepath/Arbitrary.hs +1/−1
- tests/abstract-filepath/EncodingSpec.hs +0/−170
- tests/abstract-filepath/OsPathSpec.hs +208/−202
- tests/abstract-filepath/Test.hs +2/−3
- tests/filepath-equivalent-tests/Gen.hs +204/−0
- tests/filepath-equivalent-tests/TestEquiv.hs +415/−416
- tests/filepath-tests/Test.hs +5/−35
- tests/filepath-tests/TestGen.hs +6/−4
System/FilePath/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MultiWayIf #-} -- This template expects CPP definitions for: -- MODULE_NAME = Posix | Windows@@ -128,10 +129,10 @@ #define STRING String #define FILEPATH FilePath #else-import Prelude (fromIntegral)-import Control.Exception ( SomeException, evaluate, try, displayException )+import Prelude (fromIntegral, return, IO, Either(..))+import Control.Exception ( catch, displayException, evaluate, fromException, toException, throwIO, Exception, SomeAsyncException(..), SomeException ) import Control.DeepSeq (force)-import GHC.IO (unsafePerformIO)+import System.IO.Unsafe (unsafePerformIO) import qualified Data.Char as C #ifdef WINDOWS import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )@@ -425,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@@ -602,6 +602,7 @@ -- > Posix: splitFileName "/" == ("/","") -- > Windows: splitFileName "c:" == ("c:","") -- > Windows: splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\","fred")+-- > Windows: splitFileName "\\\\?\\A:" == ("\\\\?\\A:","") splitFileName :: FILEPATH -> (STRING, STRING) splitFileName x = if null path then (dotSlash, file)@@ -644,21 +645,44 @@ -- or UNC location "\\?\UNC\foo", where path separator is a part of the drive name. -- We can test this by trying dropDrive and falling back to splitDrive. | isWindows- , Just (s1, _s2, bs') <- uncons2 dirSlash- , isPathSeparator s1- -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator,- -- so we are in the middle of shared drive.- -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path.- , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash)- = (fp, mempty)+ = case uncons2 dirSlash of+ Just (s1, s2, bs')+ | isPathSeparator s1+ -- If bs' is empty, then s2 as the last character of dirSlash must be a path separator,+ -- so we are in the middle of shared drive.+ -- Otherwise, since s1 is a path separator, we might be in the middle of UNC path.+ , null bs' || maybe False isIncompleteUNC (readDriveUNC dirSlash)+ -> (fp, mempty)+ -- This handles inputs like "//?/A:" and "//?/A:foo"+ | isPathSeparator s1+ , isPathSeparator s2+ , Just (s3, s4, bs'') <- uncons2 bs'+ , s3 == _question+ , isPathSeparator s4+ , null bs''+ , Just (drive, rest) <- readDriveLetter file+ -> (dirSlash <> drive, rest)+ _ -> (dirSlash, file) | otherwise- = (dirSlash, file)+ = (dirSlash, file) where (dirSlash, file) = breakEnd isPathSeparator fp+ dropExcessTrailingPathSeparators x+ | hasTrailingPathSeparator x+ , let x' = dropWhileEnd isPathSeparator x+ , otherwise = if | null x' -> singleton (last x)+ | otherwise -> addTrailingPathSeparator x'+ | otherwise = x + -- an "incomplete" UNC is one without a path (but potentially a drive) isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref)- hasPenultimateColon = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc + -- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@+ hasPenultimateColon pref+ | hasTrailingPathSeparator pref+ = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref+ | otherwise = False+ -- | Set the filename. -- -- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"@@ -671,6 +695,7 @@ -- -- > dropFileName "/directory/file.ext" == "/directory/" -- > dropFileName x == fst (splitFileName x)+-- > isPrefixOf (takeDrive x) (dropFileName x) dropFileName :: FILEPATH -> FILEPATH dropFileName = fst . splitFileName @@ -1245,15 +1270,31 @@ snoc str = \c -> str <> [c] #else+-- | Like 'try', but rethrows async exceptions.+trySafe :: Exception e => IO a -> IO (Either e a)+trySafe ioA = catch action eHandler+ where+ action = do+ v <- ioA+ return (Right v)+ eHandler e+ | isAsyncException e = throwIO e+ | otherwise = return (Left e)++isAsyncException :: Exception e => e -> Bool+isAsyncException e =+ case fromException (toException e) of+ Just (SomeAsyncException _) -> True+ Nothing -> False #ifdef WINDOWS fromString :: P.String -> STRING fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do- r <- try @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr+ r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr evaluate $ force $ first displayException r #else fromString :: P.String -> STRING fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do- r <- try @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr+ r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr evaluate $ force $ first displayException r #endif
System/OsPath/Common.hs view
@@ -42,8 +42,9 @@ #endif -- * Filepath construction , PS.encodeUtf+ , PS.unsafeEncodeUtf , PS.encodeWith- , PS.encodeFS+ , encodeFS #if defined(WINDOWS) || defined(POSIX) , pstr #else@@ -54,7 +55,7 @@ -- * Filepath deconstruction , PS.decodeUtf , PS.decodeWith- , PS.decodeFS+ , decodeFS , PS.unpack -- * Word construction@@ -114,30 +115,43 @@ , toChar , decodeUtf , decodeWith- , decodeFS , pack , encodeUtf+ , unsafeEncodeUtf , encodeWith- , encodeFS , unpack ) import Data.Bifunctor ( bimap ) import qualified System.OsPath.Windows.Internal as C import GHC.IO.Encoding.UTF16 ( mkUTF16le )-import Language.Haskell.TH.Quote+#if __GLASGOW_HASKELL__ >= 914+import Language.Haskell.TH.Lift+ ( Lift(..), lift )+import Language.Haskell.TH.QuasiQuoter ( QuasiQuoter (..) )+#else import Language.Haskell.TH.Syntax- ( Lift (..), lift )+ ( Lift(..), lift )+import Language.Haskell.TH.Quote+ ( QuasiQuoter (..) )+#endif import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) import Control.Monad ( when ) #elif defined(POSIX) import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) import Control.Monad ( when )-import Language.Haskell.TH.Quote+#if __GLASGOW_HASKELL__ >= 914+import Language.Haskell.TH.Lift+ ( Lift(..), lift )+import Language.Haskell.TH.QuasiQuoter ( QuasiQuoter (..) )+#else import Language.Haskell.TH.Syntax- ( Lift (..), lift )+ ( Lift(..), lift )+import Language.Haskell.TH.Quote+ ( QuasiQuoter (..) )+#endif import GHC.IO.Encoding.UTF8 ( mkUTF8 ) import System.OsPath.Types@@ -146,11 +160,10 @@ , toChar , decodeUtf , decodeWith- , decodeFS , pack , encodeUtf+ , unsafeEncodeUtf , encodeWith- , encodeFS , unpack ) import Data.Bifunctor ( bimap )@@ -162,11 +175,10 @@ ( osp , decodeUtf , decodeWith- , decodeFS , pack , encodeUtf+ , unsafeEncodeUtf , encodeWith- , encodeFS , unpack ) import System.OsPath.Types@@ -183,6 +195,7 @@ ( bimap ) #endif import System.OsString.Internal.Types+import System.OsString.Encoding.Internal ------------------------@@ -1435,3 +1448,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
@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-} -- needed to quote a view pattern module System.OsPath.Internal where @@ -13,17 +15,28 @@ ( MonadThrow ) import Data.ByteString ( ByteString )-import Language.Haskell.TH.Quote+#if __GLASGOW_HASKELL__ >= 914+import Language.Haskell.TH.Lift+ ( Lift(..), lift )+import Language.Haskell.TH.QuasiQuoter ( QuasiQuoter (..) )+#else import Language.Haskell.TH.Syntax- ( Lift (..), lift )+ ( Lift(..), lift )+import Language.Haskell.TH.Quote+ ( QuasiQuoter (..) )+#endif import GHC.IO.Encoding.Failure ( CodingFailureMode(..) ) import System.OsString.Internal.Types import System.OsPath.Encoding import Control.Monad (when)+#if !defined(__MHS__) import System.IO ( TextEncoding )+#else+import GHC.IO.Encoding.Types ( TextEncoding )+#endif #if defined(mingw32_HOST_OS) || defined(__MINGW32__) import qualified System.OsPath.Windows as PF@@ -32,6 +45,7 @@ import qualified System.OsPath.Posix as PF import GHC.IO.Encoding.UTF8 ( mkUTF8 ) #endif+import GHC.Stack (HasCallStack) @@ -40,13 +54,25 @@ -- On windows this encodes as UTF16-LE (strictly), which is a pretty good guess. -- On unix this encodes as UTF8 (strictly), which is a good guess. ----- Throws a 'EncodingException' if encoding fails.+-- Throws an 'EncodingException' if encoding fails. If the input does not+-- contain surrogate chars, you can use 'unsafeEncodeUtf'. encodeUtf :: MonadThrow m => FilePath -> m OsPath encodeUtf = OS.encodeUtf +-- | Unsafe unicode friendly encoding.+--+-- Like 'encodeUtf', except it crashes when the input contains+-- surrogate chars. For sanitized input, this can be useful.+unsafeEncodeUtf :: HasCallStack => String -> OsString+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@@ -109,9 +135,11 @@ +#if defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) -- | QuasiQuote an 'OsPath'. This accepts Unicode characters -- and encodes as UTF-8 on unix and UTF-16LE on windows. Runs 'isValid'--- on the input.+-- on the input. If used as a pattern, requires turning on the @ViewPatterns@+-- extension. osp :: QuasiQuoter osp = QuasiQuoter #if defined(mingw32_HOST_OS) || defined(__MINGW32__)@@ -119,26 +147,34 @@ osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') lift osp'- , quotePat = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"+ , quotePat = \s -> do+ osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF16le ErrorOnCodingFailure) $ s+ when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')+ [p|((==) osp' -> True)|] , quoteType = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a type)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" , quoteDec = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" } #else { quoteExp = \s -> do osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp') lift osp'- , quotePat = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"+ , quotePat = \s -> do+ osp' <- either (fail . show) (pure . OsString) . PF.encodeWith (mkUTF8 ErrorOnCodingFailure) $ s+ when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')+ [p|((==) osp' -> True)|] , quoteType = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a type)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" , quoteDec = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" } #endif+#else+osp :: a+osp = error "System.OsPath.Internal.ostr: no Template Haskell"+#endif /* defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) */ -- | Unpack an 'OsPath' to a list of 'OsChar'.
System/OsPath/Posix.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-} #undef WINDOWS #define POSIX@@ -9,6 +11,7 @@ #include "Common.hs" +#if defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) -- | QuasiQuote a 'PosixPath'. This accepts Unicode characters -- and encodes as UTF-8. Runs 'isValid' on the input. pstr :: QuasiQuoter@@ -18,10 +21,17 @@ ps <- either (fail . show) pure $ encodeWith (mkUTF8 ErrorOnCodingFailure) s when (not $ isValid ps) $ fail ("filepath not valid: " ++ show ps) lift ps- , quotePat = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"+ , quotePat = \s -> do+ osp' <- either (fail . show) pure . encodeWith (mkUTF8 ErrorOnCodingFailure) $ s+ when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')+ [p|((==) osp' -> True)|] , quoteType = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a type)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" , quoteDec = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" }+#else+pstr :: a+pstr = error "System.OsPath.Posix.pstr: no Template Haskell"+#endif /* defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) */+
System/OsPath/Windows.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE ViewPatterns #-} #undef POSIX #define IS_WINDOWS True@@ -9,7 +11,7 @@ #include "Common.hs" -+#if defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskell_quasiquoter) -- | QuasiQuote a 'WindowsPath'. This accepts Unicode characters -- and encodes as UTF-16LE. Runs 'isValid' on the input. pstr :: QuasiQuoter@@ -19,10 +21,16 @@ ps <- either (fail . show) pure $ encodeWith (mkUTF16le ErrorOnCodingFailure) s when (not $ isValid ps) $ fail ("filepath not valid: " ++ show ps) lift ps- , quotePat = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"+ , quotePat = \s -> do+ osp' <- either (fail . show) pure . encodeWith (mkUTF16le ErrorOnCodingFailure) $ s+ when (not $ isValid osp') $ fail ("filepath not valid: " ++ show osp')+ [p|((==) osp' -> True)|] , quoteType = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a type)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a type)" , quoteDec = \_ ->- fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"+ fail "illegal QuasiQuote (allowed as expression or pattern only, used as a declaration)" }+#else+pstr :: a+pstr = error "Systen.OsPath.Windows.pstr: no Template Haskell"+#endif /* defined(MIN_VERSION_template_haskell) || defined(MIN_VERSION_template_haskellquasi_quoter) */
changelog.md view
@@ -2,6 +2,25 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._ +## 1.5.5.0 *Jan 2026*++* support MicroHS wrt [#257](https://github.com/haskell/filepath/pull/257)+* Switch from template-haskell to template-haskell-quasiquoter and -lift wrt [#258](https://github.com/haskell/filepath/pull/258)++## 1.5.4.0 *Nov 2024*++* Don't catch async exceptions in internal functions wrt https://github.com/haskell/os-string/issues/22++## 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)`+* make `osp :: QuasiQuoter` valid as a pattern wrt [#210](https://github.com/haskell/filepath/pull/210)+* Add `unsafeEncodeUtf` from os-string+ ## 1.5.0.0 *Nov 2023* * remove `OsString` modules
filepath.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.2 name: filepath-version: 1.5.0.0+version: 1.5.5.0 -- NOTE: Don't forget to update ./changelog.md license: BSD-3-Clause license-file: LICENSE author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Julian Ospald <hasufell@posteo.de>-copyright: Neil Mitchell 2005-2020, Julain Ospald 2021-2022+copyright: Neil Mitchell 2005-2020, Julian Ospald 2021-2022 bug-reports: https://github.com/haskell/filepath/issues homepage: https://github.com/haskell/filepath/blob/master/README.md@@ -16,14 +16,14 @@ build-type: Simple synopsis: Library for manipulating FilePaths in a cross platform way. tested-with:- GHC ==8.0.2- || ==8.2.2- || ==8.4.4- || ==8.6.5+ GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2- || ==9.2.3+ || ==9.2.8+ || ==9.4.8+ || ==9.6.3+ || ==9.8.1 description: This package provides functionality for manipulating @FilePath@ values, and is shipped with <https://www.haskell.org/ghc/ GHC>. It provides two variants for filepaths:@@ -91,12 +91,20 @@ default-language: Haskell2010 build-depends:- , base >=4.9 && <4.20+ , base >=4.12.0.0 && <4.23 , bytestring >=0.11.3.0 , deepseq , exceptions- , template-haskell- , os-string >=2.0.0+ , os-string >=2.0.1+ -- template-haskell-lift was added as a boot library in GHC-9.14+ -- once we no longer wish to backport releases to older major releases,+ -- this conditional can be dropped+ if impl(ghc < 9.14)+ build-depends: template-haskell+ elif impl(ghc)+ build-depends:+ , template-haskell-lift >=0.1 && <0.2+ , template-haskell-quasiquoter >=0.1 && <0.2 ghc-options: -Wall @@ -116,8 +124,9 @@ , base , bytestring >=0.11.3.0 , filepath- , os-string >=2.0.0- , QuickCheck >=2.7 && <2.15+ , os-string >=2.0.1+ , tasty+ , tasty-quickcheck default-language: Haskell2010 ghc-options: -Wall@@ -133,13 +142,18 @@ Legacy.System.FilePath.Posix Legacy.System.FilePath.Windows TestUtil+ Gen build-depends: , base , bytestring >=0.11.3.0 , filepath- , os-string >=2.0.0- , QuickCheck >=2.7 && <2.15+ , generic-random+ , generic-deriving+ , os-string >=2.0.1+ , tasty+ , tasty-quickcheck+ , QuickCheck test-suite abstract-filepath default-language: Haskell2010@@ -149,7 +163,6 @@ hs-source-dirs: tests tests/abstract-filepath other-modules: Arbitrary- EncodingSpec OsPathSpec TestUtil @@ -158,9 +171,10 @@ , bytestring >=0.11.3.0 , deepseq , filepath- , os-string >=2.0.0- , QuickCheck >=2.7 && <2.15+ , os-string >=2.0.1 , quickcheck-classes-base ^>=0.6.2+ , tasty+ , tasty-quickcheck benchmark bench-filepath default-language: Haskell2010@@ -173,7 +187,7 @@ , bytestring >=0.11.3.0 , deepseq , filepath- , os-string >=2.0.0+ , os-string >=2.0.1 , tasty-bench ghc-options: -with-rtsopts=-A32m
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/EncodingSpec.hs
@@ -1,170 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TypeApplications #-}--module EncodingSpec where--import Data.ByteString ( ByteString )-import qualified Data.ByteString as BS--import Arbitrary-import Test.QuickCheck--import Data.Either ( isRight )-import qualified System.OsString.Data.ByteString.Short as BS8-import qualified System.OsString.Data.ByteString.Short.Word16 as BS16-import System.OsString.Encoding.Internal-import GHC.IO (unsafePerformIO)-import GHC.IO.Encoding ( setFileSystemEncoding )-import System.IO- ( utf16le )-import Control.Exception-import Control.DeepSeq-import Data.Bifunctor ( first )-import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )-import GHC.IO.Encoding.UTF16 ( mkUTF16le )-import GHC.IO.Encoding.UTF8 ( mkUTF8 )---tests :: [(String, Property)]-tests =- [ ("ucs2le_decode . ucs2le_encode == id",- property $ \(padEven -> ba) ->- let decoded = decodeWithTE ucs2le (BS8.toShort ba)- encoded = encodeWithTE ucs2le =<< decoded- in (BS8.fromShort <$> encoded) === Right ba)- , ("utf16 doesn't handle invalid surrogate pairs",- property $- let str = [toEnum 55296, toEnum 55297]- encoded = encodeWithTE utf16le str- decoded = decodeWithTE utf16le =<< encoded-#if __GLASGOW_HASKELL__ >= 904- in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing))-#else- in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing))-#endif- , ("ucs2 handles invalid surrogate pairs",- property $- let str = [toEnum 55296, toEnum 55297]- encoded = encodeWithTE ucs2le str- decoded = decodeWithTE ucs2le =<< encoded- in decoded === Right str)- , ("can roundtrip arbitrary bytes through utf-8 (with RoundtripFailure)",- property $- \bs ->- let decoded = decodeWithTE (mkUTF8 RoundtripFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF8 RoundtripFailure) =<< decoded- in (either (const 0) BS8.length encoded, encoded) === (BS8.length (BS8.toShort bs), Right (BS8.toShort bs)))-- , ("can decode arbitrary strings through utf-8 (with RoundtripFailure)",- property $- \(NonNullSurrogateString str) ->- let encoded = encodeWithTE (mkUTF8 RoundtripFailure) str- decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded- in expectFailure $ (either (const 0) length decoded, decoded) === (length str, Right str))-- , ("utf-8 roundtrip encode cannot deal with some surrogates",- property $- let str = [toEnum 0xDFF0, toEnum 0xDFF2]- encoded = encodeWithTE (mkUTF8 RoundtripFailure) str- decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded-#if __GLASGOW_HASKELL__ >= 904- in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing))-#else- in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing))-#endif-- , ("cannot roundtrip arbitrary bytes through utf-16 (with RoundtripFailure)",- property $- \(padEven -> bs) ->- let decoded = decodeWithTE (mkUTF16le RoundtripFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF16le RoundtripFailure) =<< decoded- in expectFailure $ (either (const 0) BS8.length encoded, encoded) === (BS8.length (BS8.toShort bs), Right (BS8.toShort bs)))- , ("encodeWithTE/decodeWithTE ErrorOnCodingFailure fails (utf16le)",- property $- \(padEven -> bs) ->- let decoded = decodeWithTE (mkUTF16le ErrorOnCodingFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF16le ErrorOnCodingFailure) =<< decoded- in expectFailure $ (isRight encoded, isRight decoded) === (True, True))- , ("encodeWithTE/decodeWithTE ErrorOnCodingFailure fails (utf8)",- property $- \bs ->- let decoded = decodeWithTE (mkUTF8 ErrorOnCodingFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF8 ErrorOnCodingFailure) =<< decoded- in expectFailure $ (isRight encoded, isRight decoded) === (True, True))- , ("encodeWithTE/decodeWithTE TransliterateCodingFailure never fails (utf16le)",- property $- \(padEven -> bs) ->- let decoded = decodeWithTE (mkUTF16le TransliterateCodingFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF16le TransliterateCodingFailure) =<< decoded- in (isRight encoded, isRight decoded) === (True, True))- , ("encodeWithTE/decodeWithTE TransliterateCodingFailure never fails (utf8)",- property $- \bs ->- let decoded = decodeWithTE (mkUTF8 TransliterateCodingFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF8 TransliterateCodingFailure) =<< decoded- in (isRight encoded, isRight decoded) === (True, True))- , ("encodeWithBaseWindows/decodeWithBaseWindows never fails (utf16le)",- property $- \(padEven -> bs) ->- let decoded = decodeW' (BS8.toShort bs)- encoded = encodeW' =<< decoded- in (isRight encoded, isRight decoded) === (True, True))- , ("encodeWithBasePosix/decodeWithBasePosix never fails (utf8b)",- property $- \bs -> ioProperty $ do- setFileSystemEncoding (mkUTF8 TransliterateCodingFailure)- let decoded = decodeP' (BS8.toShort bs)- encoded = encodeP' =<< decoded- pure $ (isRight encoded, isRight decoded) === (True, True))-- , ("decodeWithBaseWindows == utf16le_b",- property $- \(BS8.toShort . padEven -> bs) ->- let decoded = decodeW' bs- decoded' = first displayException $ decodeWithTE (mkUTF16le_b ErrorOnCodingFailure) bs- in decoded === decoded')-- , ("encodeWithBaseWindows == utf16le_b",- property $- \(NonNullSurrogateString str) ->- let decoded = encodeW' str- decoded' = first displayException $ encodeWithTE (mkUTF16le_b ErrorOnCodingFailure) str- in decoded === decoded')-- , ("encodeWithTE/decodeWithTE never fails (utf16le_b)",- property $- \(padEven -> bs) ->- let decoded = decodeWithTE (mkUTF16le_b ErrorOnCodingFailure) (BS8.toShort bs)- encoded = encodeWithTE (mkUTF16le_b ErrorOnCodingFailure) =<< decoded- in (isRight encoded, isRight decoded) === (True, True))- ]---padEven :: ByteString -> ByteString-padEven bs- | even (BS.length bs) = bs- | otherwise = bs `BS.append` BS.pack [70]---decodeP' :: BS8.ShortByteString -> Either String String-decodeP' ba = unsafePerformIO $ do- r <- try @SomeException $ decodeWithBasePosix ba- evaluate $ force $ first displayException r--encodeP' :: String -> Either String BS8.ShortByteString-encodeP' str = unsafePerformIO $ do- r <- try @SomeException $ encodeWithBasePosix str- evaluate $ force $ first displayException r--decodeW' :: BS16.ShortByteString -> Either String String-decodeW' ba = unsafePerformIO $ do- r <- try @SomeException $ decodeWithBaseWindows ba- evaluate $ force $ first displayException r--encodeW' :: String -> Either String BS8.ShortByteString-encodeW' str = unsafePerformIO $ do- r <- try @SomeException $ encodeWithBaseWindows str- evaluate $ force $ first displayException r-
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,8 +1,7 @@ module Main (main) where import qualified OsPathSpec-import qualified EncodingSpec-import TestUtil+import Test.Tasty main :: IO ()-main = runTests (EncodingSpec.tests ++ OsPathSpec.tests)+main = defaultMain OsPathSpec.tests
+ tests/filepath-equivalent-tests/Gen.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE CPP #-}+{-# 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++#if !MIN_VERSION_QuickCheck(2,17,0)+instance Arbitrary a => Arbitrary (NonEmpty a) where+ arbitrary = NE.fromList <$> listOf1' arbitrary+ shrink = genericShrink+#endif
tests/filepath-equivalent-tests/TestEquiv.hs view
@@ -1,434 +1,433 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeApplications #-} module Main where -import Test.QuickCheck hiding ((==>))+import Test.Tasty+import Test.Tasty.QuickCheck hiding ((==>)) import TestUtil import Prelude as P+import Data.Char (isAsciiLower, isAsciiUpper)+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 Data.Char (isAsciiLower, isAsciiUpper) main :: IO ()-main = runTests equivalentTests+main = defaultMain equivalentTests -equivalentTests :: [(String, Property)]-equivalentTests =- [- ( "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 $ \p -> W.splitSearchPath p == LW.splitSearchPath p- )- ,- ( "splitExtension (windows)"- , property $ \p -> W.splitExtension p == LW.splitExtension p- )- ,- ( "takeExtension (windows)"- , property $ \p -> W.takeExtension p == LW.takeExtension p- )- ,- ( "replaceExtension (windows)"- , property $ \p s -> W.replaceExtension p s == LW.replaceExtension p s- )- ,- ( "dropExtension (windows)"- , property $ \p -> W.dropExtension p == LW.dropExtension p- )- ,- ( "addExtension (windows)"- , property $ \p s -> W.addExtension p s == LW.addExtension p s- )- ,- ( "hasExtension (windows)"- , property $ \p -> W.hasExtension p == LW.hasExtension p- )- ,- ( "splitExtensions (windows)"- , property $ \p -> W.splitExtensions p == LW.splitExtensions p- )- ,- ( "dropExtensions (windows)"- , property $ \p -> W.dropExtensions p == LW.dropExtensions p- )- ,- ( "takeExtensions (windows)"- , property $ \p -> W.takeExtensions p == LW.takeExtensions p- )- ,- ( "replaceExtensions (windows)"- , property $ \p s -> W.replaceExtensions p s == LW.replaceExtensions p s- )- ,- ( "isExtensionOf (windows)"- , property $ \p s -> W.isExtensionOf p s == LW.isExtensionOf p s- )- ,- ( "stripExtension (windows)"- , property $ \p s -> W.stripExtension p s == LW.stripExtension p s- )- ,- ( "splitFileName (windows)"- , property $ \p -> W.splitFileName p == LW.splitFileName p- )- ,- ( "takeFileName (windows)"- , property $ \p -> W.takeFileName p == LW.takeFileName p- )- ,- ( "replaceFileName (windows)"- , property $ \p s -> W.replaceFileName p s == LW.replaceFileName p s- )- ,- ( "dropFileName (windows)"- , property $ \p -> W.dropFileName p == LW.dropFileName p- )- ,- ( "takeBaseName (windows)"- , property $ \p -> W.takeBaseName p == LW.takeBaseName p- )- ,- ( "replaceBaseName (windows)"- , property $ \p s -> W.replaceBaseName p s == LW.replaceBaseName p s- )- ,- ( "takeDirectory (windows)"- , property $ \p -> W.takeDirectory p == LW.takeDirectory p- )- ,- ( "replaceDirectory (windows)"- , property $ \p s -> W.replaceDirectory p s == LW.replaceDirectory p s- )- ,- ( "combine (windows)"- , property $ \p s -> W.combine p s == LW.combine p s- )- ,- ( "splitPath (windows)"- , property $ \p -> W.splitPath p == LW.splitPath p- )- ,- ( "joinPath (windows)"- , property $ \p -> W.joinPath p == LW.joinPath p- )- ,- ( "splitDirectories (windows)"- , property $ \p -> W.splitDirectories p == LW.splitDirectories p- )- ,- ( "splitDirectories (windows)"- , property $ \p -> W.splitDirectories p == LW.splitDirectories p- )- ,- ( "splitDrive (windows)"- , property $ \p -> W.splitDrive p == LW.splitDrive p- )- ,- ( "joinDrive (windows)"- , property $ \p s -> W.joinDrive p s == LW.joinDrive p s- )- ,- ( "takeDrive (windows)"- , property $ \p -> W.takeDrive p == LW.takeDrive p- )- ,- ( "hasDrive (windows)"- , property $ \p -> W.hasDrive p == LW.hasDrive p- )- ,- ( "dropDrive (windows)"- , property $ \p -> W.dropDrive p == LW.dropDrive p- )- ,- ( "isDrive (windows)"- , property $ \p -> W.isDrive p == LW.isDrive p- )- ,- ( "hasTrailingPathSeparator (windows)"- , property $ \p -> W.hasTrailingPathSeparator p == LW.hasTrailingPathSeparator p- )- ,- ( "addTrailingPathSeparator (windows)"- , property $ \p -> W.addTrailingPathSeparator p == LW.addTrailingPathSeparator p- )- ,- ( "dropTrailingPathSeparator (windows)"- , property $ \p -> W.dropTrailingPathSeparator p == LW.dropTrailingPathSeparator p- )- ,- ( "normalise (windows)"- , property $ \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 :: TestTree+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"))@@ -458,6 +454,8 @@ ,("AFP_W.splitFileName (\"c:\") == ((\"c:\"), (\"\"))", property $ AFP_W.splitFileName ("c:") == (("c:"), (""))) ,("W.splitFileName \"\\\\\\\\?\\\\A:\\\\fred\" == (\"\\\\\\\\?\\\\A:\\\\\", \"fred\")", property $ W.splitFileName "\\\\?\\A:\\fred" == ("\\\\?\\A:\\", "fred")) ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\\\\fred\") == ((\"\\\\\\\\?\\\\A:\\\\\"), (\"fred\"))", property $ AFP_W.splitFileName ("\\\\?\\A:\\fred") == (("\\\\?\\A:\\"), ("fred")))+ ,("W.splitFileName \"\\\\\\\\?\\\\A:\" == (\"\\\\\\\\?\\\\A:\", \"\")", property $ W.splitFileName "\\\\?\\A:" == ("\\\\?\\A:", ""))+ ,("AFP_W.splitFileName (\"\\\\\\\\?\\\\A:\") == ((\"\\\\\\\\?\\\\A:\"), (\"\"))", property $ AFP_W.splitFileName ("\\\\?\\A:") == (("\\\\?\\A:"), (""))) ,("P.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ P.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext") ,("W.replaceFileName \"/directory/other.txt\" \"file.ext\" == \"/directory/file.ext\"", property $ W.replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext") ,("AFP_P.replaceFileName (\"/directory/other.txt\") (\"file.ext\") == (\"/directory/file.ext\")", property $ AFP_P.replaceFileName ("/directory/other.txt") ("file.ext") == ("/directory/file.ext"))@@ -474,6 +472,10 @@ ,("W.dropFileName x == fst (W.splitFileName x)", property $ \(QFilePath x) -> W.dropFileName x == fst (W.splitFileName x)) ,("AFP_P.dropFileName x == fst (AFP_P.splitFileName x)", property $ \(QFilePathAFP_P x) -> AFP_P.dropFileName x == fst (AFP_P.splitFileName x)) ,("AFP_W.dropFileName x == fst (AFP_W.splitFileName x)", property $ \(QFilePathAFP_W x) -> AFP_W.dropFileName x == fst (AFP_W.splitFileName x))+ ,("isPrefixOf (P.takeDrive x) (P.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (P.takeDrive x) (P.dropFileName x))+ ,("isPrefixOf (W.takeDrive x) (W.dropFileName x)", property $ \(QFilePath x) -> isPrefixOf (W.takeDrive x) (W.dropFileName x))+ ,("(\\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x)", property $ \(QFilePathAFP_P x) -> (\(getPosixString -> x) (getPosixString -> y) -> SBS.isPrefixOf x y) (AFP_P.takeDrive x) (AFP_P.dropFileName x))+ ,("(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x)", property $ \(QFilePathAFP_W x) -> (\(getWindowsString -> x) (getWindowsString -> y) -> SBS16.isPrefixOf x y) (AFP_W.takeDrive x) (AFP_W.dropFileName x)) ,("P.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ P.takeFileName "/directory/file.ext" == "file.ext") ,("W.takeFileName \"/directory/file.ext\" == \"file.ext\"", property $ W.takeFileName "/directory/file.ext" == "file.ext") ,("AFP_P.takeFileName (\"/directory/file.ext\") == (\"file.ext\")", property $ AFP_P.takeFileName ("/directory/file.ext") == ("file.ext"))