packages feed

path 0.9.5 → 0.9.6

raw patch · 46 files changed

+3435/−968 lines, 46 filesdep +os-stringdep +validity-bytestringdep −genvalidity-propertydep −mtldep −validitydep ~aesondep ~basedep ~exceptions

Dependencies added: os-string, validity-bytestring

Dependencies removed: genvalidity-property, mtl, validity

Dependency ranges changed: aeson, base, exceptions, filepath, hashable

Files

CHANGELOG view
@@ -1,3 +1,6 @@+0.9.6+  * Support for `ospath`+ 0.9.5   * Add `splitDrive`, `takeDrive`, `dropDrive` and `isDrive`.
README.md view
@@ -180,7 +180,6 @@ ```  That’s really convenient and we take advantage of this at FP Complete a lot.-The instances  Equality, ordering and printing are simply re-using the `String` instances: @@ -441,7 +440,7 @@  ### pathtype -Finally, we come to a path library that path is similar to: the+Finally, we come to a path library that is similar to: the [`pathtype`](http://hackage.haskell.org/package/pathtype) library. There are the same types of `Path Abs File` / `Path Rel Dir`, etc. @@ -486,7 +485,7 @@ False ``` -* It has functions like `<.>/addExtension` which lets you insert an+* It has functions like `<.>/addExtension` which let you insert an   arbitrary string into a path.  * Some functions let you produce nonsense (could be prevented by a stricter
+ os-string-compat/System/OsString/Compat/Include.hs view
@@ -0,0 +1,139 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows+--     PLATFORM_STRING = PosixString | WindowsString+--     PLATFORM_CHAR = PosixChar | WindowsChar+--     IS_WINDOWS = 0 | 1++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE StandaloneDeriving #-}++{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#define USE_os_string 0+#if defined MIN_VERSION_os_string+#if MIN_VERSION_os_string(2,0,0)+#undef USE_os_string+#define USE_os_string 1+#endif+#endif++module System.OsString.Compat.PLATFORM_NAME+#if USE_os_string+  ( PLATFORM_STRING(..)+  , PLATFORM_CHAR(..)+  , module OsString+  )+#else+  ( PLATFORM_STRING(..)+  , PLATFORM_CHAR(..)+  , OsString.pstr+  , System.OsString.Compat.PLATFORM_NAME.all+  , System.OsString.Compat.PLATFORM_NAME.any+  , System.OsString.Compat.PLATFORM_NAME.break+  , System.OsString.Compat.PLATFORM_NAME.breakEnd+  , System.OsString.Compat.PLATFORM_NAME.dropWhileEnd+  , System.OsString.Compat.PLATFORM_NAME.empty+  , System.OsString.Compat.PLATFORM_NAME.init+  , System.OsString.Compat.PLATFORM_NAME.isInfixOf+  , System.OsString.Compat.PLATFORM_NAME.isPrefixOf+  , System.OsString.Compat.PLATFORM_NAME.isSuffixOf+  , System.OsString.Compat.PLATFORM_NAME.length+  , System.OsString.Compat.PLATFORM_NAME.map+  , System.OsString.Compat.PLATFORM_NAME.null+  , System.OsString.Compat.PLATFORM_NAME.replicate+  , System.OsString.Compat.PLATFORM_NAME.singleton+  , System.OsString.Compat.PLATFORM_NAME.span+  , System.OsString.Compat.PLATFORM_NAME.spanEnd+  , System.OsString.Compat.PLATFORM_NAME.stripPrefix+  , System.OsString.Compat.PLATFORM_NAME.uncons+  )+#endif+  where++import Data.Data (Data)+import System.OsString.Internal.Types (PLATFORM_STRING(..), PLATFORM_CHAR(..))+import System.OsString.PLATFORM_NAME as OsString++#if !USE_os_string+import Data.Coerce (coerce)++#if IS_WINDOWS+import qualified System.OsPath.Data.ByteString.Short.Word16 as BSP+#else+import qualified System.OsPath.Data.ByteString.Short as BSP+#endif+#endif++deriving instance Data PLATFORM_STRING++#if !USE_os_string+all :: (PLATFORM_CHAR -> Bool) -> PLATFORM_STRING -> Bool+all = coerce BSP.all++any :: (PLATFORM_CHAR -> Bool) -> PLATFORM_STRING -> Bool+any = coerce BSP.any++break+  :: (PLATFORM_CHAR -> Bool)+  -> PLATFORM_STRING+  -> (PLATFORM_STRING, PLATFORM_STRING)+break = coerce BSP.break++breakEnd+  :: (PLATFORM_CHAR -> Bool)+  -> PLATFORM_STRING+  -> (PLATFORM_STRING, PLATFORM_STRING)+breakEnd = coerce BSP.breakEnd++dropWhileEnd :: (PLATFORM_CHAR -> Bool) -> PLATFORM_STRING -> PLATFORM_STRING+dropWhileEnd = coerce BSP.dropWhileEnd++empty :: PLATFORM_STRING+empty = coerce BSP.empty++init :: PLATFORM_STRING -> PLATFORM_STRING+init = coerce BSP.init++isInfixOf :: PLATFORM_STRING -> PLATFORM_STRING -> Bool+isInfixOf = coerce BSP.isInfixOf++isPrefixOf :: PLATFORM_STRING -> PLATFORM_STRING -> Bool+isPrefixOf = coerce BSP.isPrefixOf++isSuffixOf :: PLATFORM_STRING -> PLATFORM_STRING -> Bool+isSuffixOf = coerce BSP.isSuffixOf++length :: PLATFORM_STRING -> Int+length = coerce BSP.length++map :: (PLATFORM_CHAR -> PLATFORM_CHAR) -> PLATFORM_STRING -> PLATFORM_STRING+map = coerce BSP.map++null :: PLATFORM_STRING -> Bool+null = coerce BSP.null++replicate :: Int -> PLATFORM_CHAR -> PLATFORM_STRING+replicate = coerce BSP.replicate++singleton :: PLATFORM_CHAR -> PLATFORM_STRING+singleton = coerce BSP.singleton++span+  :: (PLATFORM_CHAR -> Bool)+  -> PLATFORM_STRING+  -> (PLATFORM_STRING, PLATFORM_STRING)+span = coerce BSP.span++spanEnd+  :: (PLATFORM_CHAR -> Bool)+  -> PLATFORM_STRING+  -> (PLATFORM_STRING, PLATFORM_STRING)+spanEnd = coerce BSP.spanEnd++stripPrefix :: PLATFORM_STRING -> PLATFORM_STRING -> Maybe PLATFORM_STRING+stripPrefix = coerce BSP.stripPrefix++uncons :: PLATFORM_STRING -> Maybe (PLATFORM_CHAR, PLATFORM_STRING)+uncons = coerce BSP.uncons+#endif
+ os-string-compat/System/OsString/Compat/Posix.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME        Posix+#define PLATFORM_STRING      PosixString+#define PLATFORM_CHAR        PosixChar+#define IS_WINDOWS           0+#include "Include.hs"
+ os-string-compat/System/OsString/Compat/Windows.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME        Windows+#define PLATFORM_STRING      WindowsString+#define PLATFORM_CHAR        WindowsChar+#define IS_WINDOWS           1+#include "Include.hs"
path.cabal view
@@ -1,95 +1,192 @@+cabal-version:       3.0 name:                path-version:             0.9.5+version:             0.9.6 synopsis:            Support for well-typed paths description:         Support for well-typed paths.-license:             BSD3+license:             BSD-3-Clause license-file:        LICENSE author:              Chris Done <chrisdone@fpcomplete.com> maintainer:          Chris Done <chrisdone@fpcomplete.com> copyright:           2015–2018 FP Complete category:            System, Filesystem build-type:          Simple-cabal-version:       1.18-tested-with:         GHC==8.6.5, GHC==8.8.4, GHC==8.10.1+tested-with:         GHC==9.2.8, GHC==9.4.8, GHC==9.6.6, GHC==9.8.2, GHC==9.10.1 extra-source-files:  README.md                    , CHANGELOG+                   , os-string-compat/System/OsString/Compat/Include.hs                    , src/Path/Include.hs                    , src/Path/Internal/Include.hs+                   , src/OsPath/Include.hs+                   , src/OsPath/Internal/Include.hs                    , test/Common/Include.hs+                   , test-ospath/Common/Include.hs+                   , validity-test-ospath/Include.hs+                   , validity-test-ospath/OsPath/Gen/Include.hs  flag dev   description:        Turn on development settings.   manual:             True   default:            False +flag os-string+  description:        Use an older version of the os-string library.+  manual:             False+  default:            False++common language+  ghc-options:        -Wall++  if flag(dev)+    ghc-options:      -Wcompat+                      -Werror+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wnoncanonical-monad-instances++  default-language:  Haskell2010++common rts+  ghc-options:        -O2+                      -threaded+                      -rtsopts+                      -with-rtsopts=-N+ library+  import: language+   hs-source-dirs:    src+   exposed-modules:   Path                    , Path.Posix                    , Path.Windows                    , Path.Internal                    , Path.Internal.Posix                    , Path.Internal.Windows-  build-depends:     aeson-                   , base       >= 4.12     && < 5+                   , OsPath+                   , OsPath.Posix+                   , OsPath.Windows+                   , OsPath.Internal+                   , OsPath.Internal.Posix+                   , OsPath.Internal.Windows++  build-depends:     aeson      >= 1.0.0.0+                   , base       >= 4.12    && < 5                    , deepseq                    , exceptions >= 0.4     && < 0.11-                   , filepath   < 1.2.0.1  || >= 1.3                    , hashable   >= 1.2     && < 1.5+                   , path:os-string-compat                    , text                    , template-haskell-  if flag(dev)-    ghc-options:      -Wall -Werror++  if flag(os-string)+    build-depends:   filepath   >= 1.5   else-    ghc-options:      -O2 -Wall-  if flag(dev)-    ghc-options:      -Wcompat-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wnoncanonical-monad-instances-  default-language:  Haskell2010+    build-depends:   filepath   >= 1.4.100.0 && <1.5 +library os-string-compat+  import: language++  hs-source-dirs:    os-string-compat+  visibility:        private++  exposed-modules:   System.OsString.Compat.Posix+                   , System.OsString.Compat.Windows++  build-depends:     base       >= 4.12    && < 5++  if flag(os-string)+    build-depends:   os-string  >= 2.0.0+  else+    build-depends:   filepath   >= 1.4.100.0+ test-suite test+  import: language+  import: rts+   type:              exitcode-stdio-1.0   main-is:           Main.hs++  hs-source-dirs:    test+   other-modules:     Posix                    , Windows                    , Common.Posix                    , Common.Windows-  hs-source-dirs:    test+                   , TH.Posix+                   , TH.Windows+   build-depends:     aeson-                   , base       >= 4.12     && < 5+                   , base                    , bytestring-                   , filepath   < 1.2.0.1  || >= 1.3+                   , exceptions+                   , filepath                    , hspec      >= 2.0     && < 3-                   , mtl        >= 2.0     && < 3                    , path                    , template-haskell-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:  Haskell2010 +test-suite test-ospath+  import: language+  import: rts++  type:              exitcode-stdio-1.0+  main-is:           Main.hs+  hs-source-dirs:    test-ospath++  other-modules:     Posix+                   , Windows+                   , Common.Posix+                   , Common.Windows+                   , TH.Posix+                   , TH.Windows++  build-depends:     base+                   , exceptions+                   , filepath+                   , hspec      >= 2.0     && < 3+                   , path+                   , path:os-string-compat+                   , template-haskell+ test-suite validity-test+  import: language+  import: rts+   type:              exitcode-stdio-1.0-  main-is:           ValidityTest.hs+  main-is:           Main.hs+  hs-source-dirs:    validity-test+   other-modules:     Path.Gen-  hs-source-dirs:    test+   build-depends:     QuickCheck-                   , aeson-                   , base       >= 4.12 && < 5-                   , bytestring-                   , filepath   < 1.2.0.1  || >= 1.3+                   , base+                   , filepath                    , genvalidity >= 1.0-                   , genvalidity-property >= 0.4                    , genvalidity-hspec >= 0.7                    , hspec      >= 2.0     && < 3-                   , mtl        >= 2.0     && < 3                    , path-                   , validity   >= 0.8.0.0-  default-language:  Haskell2010-  ghc-options: -threaded -rtsopts -with-rtsopts=-N++test-suite validity-test-ospath+  import: language+  import: rts++  type:              exitcode-stdio-1.0+  main-is:           Main.hs+  hs-source-dirs:    validity-test-ospath++  other-modules:     OsPath.Gen.Posix+                   , OsPath.Gen.Windows+                   , Posix+                   , Windows++  build-depends:     QuickCheck+                   , base+                   , filepath+                   , genvalidity >= 1.0+                   , genvalidity-hspec >= 0.7+                   , hspec      >= 2.0     && < 3+                   , path+                   , path:os-string-compat+                   , validity-bytestring >=0.4.1.0  source-repository head   type:              git
+ src/OsPath.hs view
@@ -0,0 +1,15 @@+-- | This library provides a well-typed representation of paths in a filesystem+-- directory tree.+--+-- Both "Path.Posix" and "Path.Windows" provide the same interface. This+-- module will reexport the appropriate module for your platform.++{-# LANGUAGE CPP #-}++#if defined(mingw32_HOST_OS)+module OsPath(module OsPath.Windows) where+import OsPath.Windows+#else+module OsPath(module OsPath.Posix) where+import OsPath.Posix+#endif
+ src/OsPath/Include.hs view
@@ -0,0 +1,819 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows++-- | This library provides a well-typed representation of paths in a filesystem+-- directory tree.+--+-- __Note__: This module is for working with PLATFORM_NAME style paths. Importing+-- "Path" is usually better.+--+-- A path is represented by a number of path components separated by a path+-- separator which is a @/@ on POSIX systems and can be a @/@ or @\\@ on Windows.+-- The root of the tree is represented by a @/@ on POSIX and a drive letter+-- followed by a @/@ or @\\@ on Windows (e.g. @C:\\@).  Paths can be absolute+-- or relative. An absolute path always starts from the root of the tree (e.g.+-- @\/x/y@) whereas a relative path never starts with the root (e.g. @x/y@).+-- Just like we represent the notion of an absolute root by "@/@", the same way+-- we represent the notion of a relative root by "@.@". The relative root denotes+-- the directory which contains the first component of a relative path.++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}++module OsPath.PLATFORM_NAME+  (-- * Types+   Path+  ,Abs+  ,Rel+  ,File+  ,Dir+  ,SomeBase(..)+   -- * Exceptions+  ,PathException(..)+  -- * QuasiQuoters+  -- | Using the following requires the QuasiQuotes language extension.+  --+  -- __For Windows users__, the QuasiQuoters are especially beneficial because they+  -- prevent Haskell from treating @\\@ as an escape character.+  -- This makes Windows paths easier to write.+  --+  -- @+  -- [absfile|C:\\chris\\foo.txt|]+  -- @+  ,absdir+  ,reldir+  ,absfile+  ,relfile+  -- * Operations+  ,(</>)+  ,stripProperPrefix+  ,isProperPrefixOf+  ,replaceProperPrefix+  ,parent+  ,filename+  ,dirname+  ,addExtension+  ,splitExtension+  ,fileExtension+  ,replaceExtension+  ,splitDrive+  ,takeDrive+  ,dropDrive+  ,isDrive+  ,mapSomeBase+  ,prjSomeBase+   -- * Parsing+  ,parseAbsDir+  ,parseRelDir+  ,parseAbsFile+  ,parseRelFile+  ,parseSomeDir+  ,parseSomeFile+  -- * Conversion+  ,toOsPath+  ,fromAbsDir+  ,fromRelDir+  ,fromAbsFile+  ,fromRelFile+  ,fromSomeBase+  ,fromSomeDir+  ,fromSomeFile+  -- * TemplateHaskell constructors+  -- | These require the TemplateHaskell language extension.+  ,mkAbsDir+  ,mkRelDir+  ,mkAbsFile+  ,mkRelFile+  -- * Deprecated+  ,PathParseException+  ,stripDir+  ,isParentOf+  ,addFileExtension+  ,(<.>)+  ,setFileExtension+  ,(-<.>)+  )+  where++import           Control.Applicative (Alternative(..))+import           Control.DeepSeq (NFData (..))+import           Control.Exception (Exception(..))+import           Control.Monad (unless, when, (<=<))+import           Control.Monad.Catch (MonadThrow(..))+import           Data.Coerce (coerce)+import           Data.Data (Data, Typeable)+import           Data.Hashable (Hashable (..))+import           Data.Maybe (isJust, isNothing)+import           GHC.Generics (Generic)+import           Language.Haskell.TH (Exp, Q)+import           Language.Haskell.TH.Syntax (lift)+import           Language.Haskell.TH.Quote (QuasiQuoter(..))+import           System.OsPath.PLATFORM_NAME (PLATFORM_PATH)+import qualified System.OsPath.PLATFORM_NAME as OsPath++import           OsPath.Internal.PLATFORM_NAME+import           System.OsString.Compat.PLATFORM_NAME (PLATFORM_STRING)+import qualified System.OsString.Compat.PLATFORM_NAME as OsString++--------------------------------------------------------------------------------+-- Types++-- | An absolute path.+data Abs deriving (Typeable, Data)++-- | A relative path; one without a root. Note that a @..@ path component to+-- represent the parent directory is not allowed by this library.+data Rel deriving (Typeable, Data)++-- | A file path.+data File deriving (Typeable, Data)++-- | A directory path.+data Dir deriving (Typeable, Data)++-- | Exceptions that can occur during path operations.+--+-- @since 0.6.0+data PathException+  = InvalidAbsDir PLATFORM_PATH+  | InvalidRelDir PLATFORM_PATH+  | InvalidAbsFile PLATFORM_PATH+  | InvalidRelFile PLATFORM_PATH+  | InvalidFile PLATFORM_PATH+  | InvalidDir PLATFORM_PATH+  | NotAProperPrefix PLATFORM_PATH PLATFORM_PATH+  | HasNoExtension PLATFORM_PATH+  | InvalidExtension PLATFORM_STRING+  deriving (Show,Eq,Typeable)++instance Exception PathException where+  displayException (InvalidExtension ext) = concat+    [ "Invalid extension "+    , show ext+    , ". A valid extension starts with a '.' followed by one or more "+    , "characters other than '.', and it must be a valid filename, "+    , "notably it cannot include a path separator."+    ]+  displayException x = show x++--------------------------------------------------------------------------------+-- QuasiQuoters++qq :: (PLATFORM_PATH -> Q Exp) -> QuasiQuoter+qq quoteExp' =+  QuasiQuoter+  { quoteExp  = quoteExp' <=< OsPath.encodeUtf+  , quotePat  = \_ ->+      fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"+  , quoteType = \_ ->+      fail "illegal QuasiQuote (allowed as expression only, used as a type)"+  , quoteDec  = \_ ->+      fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"+  }++-- | Construct a 'Path' 'Abs' 'Dir' using QuasiQuotes.+--+-- @+-- [absdir|/|]+--+-- [absdir|\/home\/chris|]+-- @+--+-- Remember: due to the nature of absolute paths a path like @[absdir|\/home\/chris|]@+-- may compile on your platform, but it may not compile on another+-- platform (Windows).+--+-- @since 0.5.13+absdir :: QuasiQuoter+absdir = qq mkAbsDir++-- | Construct a 'Path' 'Rel' 'Dir' using QuasiQuotes.+--+-- @+-- [absdir|\/home|]\<\/>[reldir|chris|]+-- @+--+-- @since 0.5.13+reldir :: QuasiQuoter+reldir = qq mkRelDir++-- | Construct a 'Path' 'Abs' 'File' using QuasiQuotes.+--+-- @+-- [absfile|\/home\/chris\/foo.txt|]+-- @+--+-- Remember: due to the nature of absolute paths a path like @[absdir|\/home\/chris\/foo.txt|]@+-- may compile on your platform, but it may not compile on another+-- platform (Windows).+--+-- @since 0.5.13+absfile :: QuasiQuoter+absfile = qq mkAbsFile++-- | Construct a 'Path' 'Rel' 'File' using QuasiQuotes.+--+-- @+-- [absdir|\/home\/chris|]\<\/>[relfile|foo.txt|]+-- @+--+-- @since 0.5.13+relfile :: QuasiQuoter+relfile = qq mkRelFile++--------------------------------------------------------------------------------+-- Operations++-- | Append two paths.+--+-- The following cases are valid and the equalities hold:+--+-- @$(mkAbsDir x) \<\/> $(mkRelDir y) = $(mkAbsDir (x <> [pstr|/|] <> y))@+--+-- @$(mkAbsDir x) \<\/> $(mkRelFile y) = $(mkAbsFile (x <> [pstr|/|] <> y))@+--+-- @$(mkRelDir x) \<\/> $(mkRelDir y) = $(mkRelDir (x <> [pstr|/|] <> y))@+--+-- @$(mkRelDir x) \<\/> $(mkRelFile y) = $(mkRelFile (x <> [pstr|/|] <> y))@+--+-- The following are proven not possible to express:+--+-- @$(mkAbsFile …) \<\/> x@+--+-- @$(mkRelFile …) \<\/> x@+--+-- @x \<\/> $(mkAbsFile …)@+--+-- @x \<\/> $(mkAbsDir …)@+--+infixr 5 </>+(</>) :: Path b Dir -> Path Rel t -> Path b t+(</>) (Path a) (Path b) = Path (a <> b)++-- | If the directory in the first argument is a proper prefix of the path in+-- the second argument strip it from the second argument, generating a path+-- relative to the directory.+-- Throws 'NotAProperPrefix' if the directory is not a proper prefix of the+-- path.+--+-- The following properties hold:+--+-- @stripProperPrefix x (x \<\/> y) = y@+--+-- Cases which are proven not possible:+--+-- @stripProperPrefix (a :: Path Abs …) (b :: Path Rel …)@+--+-- @stripProperPrefix (a :: Path Rel …) (b :: Path Abs …)@+--+-- In other words the bases must match.+--+-- @since 0.6.0+stripProperPrefix :: MonadThrow m+         => Path b Dir -> Path b t -> m (Path Rel t)+stripProperPrefix (Path p) (Path l) =+  case OsString.stripPrefix p l of+    Nothing -> throwM (NotAProperPrefix p l)+    Just result+      | OsString.null result -> throwM (NotAProperPrefix p l)+      | otherwise -> return (Path result)++-- | Determines if the path in the first parameter is a proper prefix of the+-- path in the second parameter.+--+-- The following properties hold:+--+-- @not (x \`isProperPrefixOf\` x)@+--+-- @x \`isProperPrefixOf\` (x \<\/\> y)@+--+-- @since 0.6.0+isProperPrefixOf :: Path b Dir -> Path b t -> Bool+isProperPrefixOf p l = isJust (stripProperPrefix p l)++-- | Change from one directory prefix to another.+--+-- Throw 'NotAProperPrefix' if the first argument is not a proper prefix of the+-- path.+--+-- >>> replaceProperPrefix $(mkRelDir "foo") $(mkRelDir "bar") $(mkRelFile "foo/file.txt") == $(mkRelFile "bar/file.txt")+replaceProperPrefix :: MonadThrow m => Path b Dir -> Path b' Dir -> Path b t -> m (Path b' t)+replaceProperPrefix src dst fp = (dst </>) <$> stripProperPrefix src fp++-- | Take the parent path component from a path.+--+-- The following properties hold:+--+-- @+-- parent (x \<\/> y) == x+-- parent [pstr|\/x|] == [pstr|\/|]+-- parent [pstr|x|] == [pstr|.|]+-- @+--+-- On the root (absolute or relative), getting the parent is idempotent:+--+-- @+-- parent [pstr|\/|] = [pstr|\/|]+-- parent [pstr|\.|] = [pstr|\.|]+-- @+--+parent :: Path b t -> Path b Dir+parent (Path fp)+  | OsString.null fp = Path OsString.empty+  | OsPath.isDrive fp = Path fp+  | otherwise =+      Path+      $ normalizeDir+      $ OsPath.takeDirectory+      $ OsPath.dropTrailingPathSeparator fp++-- | Split an absolute path into a drive and, perhaps, a path. On POSIX, @/@ is+-- a drive.+splitDrive :: Path Abs t -> (Path Abs Dir, Maybe (Path Rel t))+splitDrive (Path fp) =+    let (d, rest) = OsPath.splitDrive fp+        mRest = if OsString.null rest then Nothing else Just (Path rest)+    in  (Path d, mRest)++-- | Get the drive from an absolute path. On POSIX, @/@ is a drive.+--+-- > takeDrive x = fst (splitDrive x)+takeDrive :: Path Abs t -> Path Abs Dir+takeDrive = fst . splitDrive++-- | Drop the drive from an absolute path. May result in 'Nothing' if the path+-- is just a drive.+--+-- > dropDrive x = snd (splitDrive x)+dropDrive :: Path Abs t -> Maybe (Path Rel t)+dropDrive = snd . splitDrive++-- | Is an absolute directory path a drive?+isDrive :: Path Abs Dir -> Bool+isDrive = isNothing . dropDrive++-- | Extract the file part of a path.+--+-- The following properties hold:+--+-- @filename (p \<\/> a) == filename a@+--+filename :: Path b File -> Path Rel File+filename (Path l) =+  Path (OsPath.takeFileName l)++-- | Extract the last directory name of a path.+--+-- The following properties hold:+--+-- @dirname $(mkRelDir ".") == $(mkRelDir ".")@+--+-- @dirname (p \<\/> a) == dirname a@+--+dirname :: Path b Dir -> Path Rel Dir+dirname (Path l)+  | OsString.null l = Path OsString.empty+  | OsPath.isDrive l = Path OsString.empty+  | otherwise = Path (last (OsPath.splitPath l))++-- | 'splitExtension' is the inverse of 'addExtension'. It splits the given+-- file path into a valid filename and a valid extension.+--+-- >>> splitExtension $(mkRelFile "name.foo"     ) == Just ($(mkRelFile "name"    ), [pstr|.foo|]  )+-- >>> splitExtension $(mkRelFile "name.foo."    ) == Just ($(mkRelFile "name"    ), [pstr|.foo.|] )+-- >>> splitExtension $(mkRelFile "name.foo.."   ) == Just ($(mkRelFile "name"    ), [pstr|.foo..|])+-- >>> splitExtension $(mkRelFile "name.bar.foo" ) == Just ($(mkRelFile "name.bar"), [pstr|.foo|]  )+-- >>> splitExtension $(mkRelFile ".name.foo"    ) == Just ($(mkRelFile ".name"   ), [pstr|.foo|]  )+-- >>> splitExtension $(mkRelFile "name..foo"    ) == Just ($(mkRelFile "name."   ), [pstr|.foo|]  )+-- >>> splitExtension $(mkRelFile "....foo"      ) == Just ($(mkRelFile "..."     ), [pstr|.foo|]  )+--+-- Throws 'HasNoExtension' exception if the filename does not have an extension+-- or in other words it cannot be split into a valid filename and a valid+-- extension. The following cases throw an exception, please note that "." and+-- ".." are not valid filenames:+--+-- >>> splitExtension $(mkRelFile "name"   )+-- >>> splitExtension $(mkRelFile "name."  )+-- >>> splitExtension $(mkRelFile "name.." )+-- >>> splitExtension $(mkRelFile ".name"  )+-- >>> splitExtension $(mkRelFile "..name" )+-- >>> splitExtension $(mkRelFile "...name")+--+-- 'splitExtension' and 'addExtension' are inverses of each other, the+-- following laws hold:+--+-- @+-- uncurry addExtension . swap >=> splitExtension == return+-- splitExtension >=> uncurry addExtension . swap == return+-- @+--+-- @since 0.7.0+splitExtension :: MonadThrow m => Path b File -> m (Path b File, PLATFORM_STRING)+splitExtension (Path ospath) =+    if OsString.null nameDot+       || OsString.null name+       || OsString.null ext+       || name == [OsString.pstr|.|]+       || name == [OsString.pstr|..|]+       then throwM $ HasNoExtension ospath+       else return ( Path (normalizeDrive drv <> dir <> name)+                   , OsString.singleton OsPath.extSeparator <> ext+                   )+    where++    -- trailing separators are ignored for the split and considered part of the+    -- second component in the split.+    splitLast isSep str =+        let (withoutTrailingSeps, trailingSeps) = OsString.spanEnd isSep str+            (oneSep, rest) = OsString.breakEnd isSep withoutTrailingSeps+        in (oneSep, rest <> trailingSeps)++    (drv, ospathRel) = OsPath.splitDrive ospath+    (dir, file)      = splitLast OsPath.isPathSeparator ospathRel+    (nameDot, ext)   = splitLast OsPath.isExtSeparator file+    name             = OsString.init nameDot++-- | Get extension from given file path. Throws 'HasNoExtension' exception if+-- the file does not have an extension.  The following laws hold:+--+-- @+-- flip addExtension file >=> fileExtension == return+-- fileExtension == (fmap snd) . splitExtension+-- @+--+-- @since 0.5.11+fileExtension :: MonadThrow m => Path b File -> m PLATFORM_STRING+fileExtension = fmap snd . splitExtension++-- | Add extension to given file path.+--+-- >>> addExtension [pstr|.foo|]   $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo"    )+-- >>> addExtension [pstr|.foo.|]  $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo."   )+-- >>> addExtension [pstr|.foo..|] $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo.."  )+-- >>> addExtension [pstr|.foo|]   $(mkRelFile "name.bar" ) == Just $(mkRelFile "name.bar.foo")+-- >>> addExtension [pstr|.foo|]   $(mkRelFile ".name"    ) == Just $(mkRelFile ".name.foo"   )+-- >>> addExtension [pstr|.foo|]   $(mkRelFile "name."    ) == Just $(mkRelFile "name..foo"   )+-- >>> addExtension [pstr|.foo|]   $(mkRelFile "..."      ) == Just $(mkRelFile "....foo"     )+--+-- Throws an 'InvalidExtension' exception if the extension is not valid. A+-- valid extension starts with a @.@ followed by one or more characters not+-- including @.@ followed by zero or more @.@ in trailing position. Moreover,+-- an extension must be a valid filename, notably it cannot include path+-- separators. Particularly, @.foo.bar@ is an invalid extension, instead you+-- have to first set @.foo@ and then @.bar@ individually. Some examples of+-- invalid extensions are:+--+-- >>> addExtension [pstr|foo|]      $(mkRelFile "name")+-- >>> addExtension [pstr|..foo|]    $(mkRelFile "name")+-- >>> addExtension [pstr|.foo.bar|] $(mkRelFile "name")+-- >>> addExtension [pstr|.foo/bar|] $(mkRelFile "name")+--+-- @since 0.7.0+addExtension :: MonadThrow m+  => PLATFORM_STRING   -- ^ Extension to add+  -> Path b File       -- ^ Old file name+  -> m (Path b File)   -- ^ New file name with the desired extension added at the end+addExtension ext (Path path) = do+    (sep, xtn) <- case OsString.uncons ext of+        Nothing -> throwM $ InvalidExtension ext+        Just result -> pure result++    let withoutTrailingSeps = OsString.dropWhileEnd OsPath.isExtSeparator xtn++    -- Has to start with a "."+    unless (OsPath.isExtSeparator sep) $+        throwM $ InvalidExtension ext++    -- Cannot have path separators+    when (OsString.any OsPath.isPathSeparator xtn) $+        throwM $ InvalidExtension ext++    -- All "."s is not a valid extension+    when (OsString.null withoutTrailingSeps) $+        throwM $ InvalidExtension ext++    -- Cannot have "."s except in trailing position+    when (OsString.any OsPath.isExtSeparator withoutTrailingSeps) $+        throwM $ InvalidExtension ext++    -- Must be valid as a filename+    _ <- parseRelFile ext++    return $ Path (path <> ext)++-- | If the file has an extension replace it with the given extension otherwise+-- add the new extension to it. Throws an 'InvalidExtension' exception if the+-- new extension is not a valid extension (see 'fileExtension' for validity+-- rules).+--+-- The following law holds:+--+-- @(fileExtension >=> flip replaceExtension file) file == return file@+--+-- @since 0.7.0+replaceExtension :: MonadThrow m+  => PLATFORM_STRING   -- ^ Extension to set+  -> Path b File       -- ^ Old file name+  -> m (Path b File)   -- ^ New file name with the desired extension+replaceExtension ext path =+    addExtension ext (maybe path fst $ splitExtension path)++--------------------------------------------------------------------------------+-- Parsers++-- | Convert an absolute PLATFORM_PATH_SINGLE to a normalized absolute dir+--   'Path'.+--+-- Throws: 'InvalidAbsDir' when the supplied path:+--+-- * is not an absolute path+-- * contains a @..@ path component representing the parent directory+-- * is not a valid path (See 'OsPath.isValid')+--+parseAbsDir :: MonadThrow m+            => PLATFORM_PATH -> m (Path Abs Dir)+parseAbsDir ospath+  | isValidAbsDir ospath = return (Path (normalizeDir ospath))+  | otherwise = throwM (InvalidAbsDir ospath)++-- | Convert a relative PLATFORM_PATH_SINGLE to a normalized relative dir+--   'Path'.+--+-- Throws: 'InvalidRelDir' when the supplied path:+--+-- * is not a relative path+-- * is @""@+-- * contains a @..@ path component representing the parent directory+-- * is not a valid path (See 'OsPath.isValid')+-- * is all path separators+--+parseRelDir :: MonadThrow m+            => PLATFORM_PATH -> m (Path Rel Dir)+parseRelDir ospath+  | isValidRelDir ospath = return (Path (normalizeDir ospath))+  | otherwise = throwM (InvalidRelDir ospath)++-- | Convert an absolute PLATFORM_PATH_SINGLE to a normalized absolute file+--   'Path'.+--+-- Throws: 'InvalidAbsFile' when the supplied path:+--+-- * is not an absolute path+-- * is a directory path i.e.+--+--     * has a trailing path separator+--     * is @.@ or ends in @/.@+--+-- * contains a @..@ path component representing the parent directory+-- * is not a valid path (See 'OsPath.isValid')+--+parseAbsFile :: MonadThrow m+             => PLATFORM_PATH -> m (Path Abs File)+parseAbsFile ospath+  | isValidAbsFile ospath+  , let normalized = normalizeFile ospath+  , isValidAbsFile normalized = return (Path normalized)+  | otherwise = throwM (InvalidAbsFile ospath)++-- | Convert a relative PLATFORM_PATH_SINGLE to a normalized relative file+--   'Path'.+--+-- Throws: 'InvalidRelFile' when the supplied path:+--+-- * is not a relative path+-- * is @""@+-- * is a directory path i.e.+--+--     * has a trailing path separator+--     * is @.@ or ends in @/.@+--+-- * contains a @..@ path component representing the parent directory+-- * is not a valid path (See 'OsPath.isValid')+--+parseRelFile :: MonadThrow m+             => PLATFORM_PATH -> m (Path Rel File)+parseRelFile ospath+  | isValidRelFile ospath+  , let normalized = normalizeFile ospath+  , isValidRelFile normalized = return (Path normalized)+  | otherwise = throwM (InvalidRelFile ospath)++--------------------------------------------------------------------------------+-- Conversion++-- | Convert absolute path to directory to PLATFORM_PATH_SINGLE type.+fromAbsDir :: Path Abs Dir -> PLATFORM_PATH+fromAbsDir = toOsPath++-- | Convert relative path to directory to PLATFORM_PATH_SINGLE type.+fromRelDir :: Path Rel Dir -> PLATFORM_PATH+fromRelDir = toOsPath++-- | Convert absolute path to file to PLATFORM_PATH_SINGLE type.+fromAbsFile :: Path Abs File -> PLATFORM_PATH+fromAbsFile = toOsPath++-- | Convert relative path to file to PLATFORM_PATH_SINGLE type.+fromRelFile :: Path Rel File -> PLATFORM_PATH+fromRelFile = toOsPath++--------------------------------------------------------------------------------+-- Constructors++-- | Make a 'Path' 'Abs' 'Dir'.+--+-- Remember: due to the nature of absolute paths this (e.g. @\/home\/foo@)+-- may compile on your platform, but it may not compile on another+-- platform (Windows).+mkAbsDir :: PLATFORM_PATH -> Q Exp+mkAbsDir = either (fail . displayException) lift . parseAbsDir++-- | Make a 'Path' 'Rel' 'Dir'.+mkRelDir :: PLATFORM_PATH -> Q Exp+mkRelDir = either (fail . displayException) lift . parseRelDir++-- | Make a 'Path' 'Abs' 'File'.+--+-- Remember: due to the nature of absolute paths this (e.g. @\/home\/foo@)+-- may compile on your platform, but it may not compile on another+-- platform (Windows).+mkAbsFile :: PLATFORM_PATH -> Q Exp+mkAbsFile = either (fail . displayException) lift . parseAbsFile++-- | Make a 'Path' 'Rel' 'File'.+mkRelFile :: PLATFORM_PATH -> Q Exp+mkRelFile = either (fail . displayException) lift . parseRelFile++--------------------------------------------------------------------------------+-- Path of some type.++-- | Path of some type.  @t@ represents the type, whether file or+-- directory. Pattern match to find whether the path is absolute or relative.+data SomeBase t = Abs (Path Abs t)+                | Rel (Path Rel t)+  deriving (Typeable, Generic, Eq, Ord)++instance NFData (SomeBase t) where+  rnf (Abs p) = rnf p+  rnf (Rel p) = rnf p++instance Show (SomeBase t) where+  show = show . fromSomeBase++instance Hashable (SomeBase t) where+  -- See 'Hashable' 'Path' instance for details.+  hashWithSalt n path = hashWithSalt n (fromSomeBase path)++-- | Helper to project the contents out of a SomeBase object.+--+-- >>> prjSomeBase toOsPath (Abs [absfile|/foo/bar/cow.moo|]) == [pstr|/foo/bar/cow.moo|]+--+prjSomeBase :: (forall b . Path b t -> a) -> SomeBase t -> a+prjSomeBase f = \case+  Abs a -> f a+  Rel r -> f r++-- | Helper to apply a function to the SomeBase object+--+-- >>> mapSomeBase parent (Abs [absfile|/foo/bar/cow.moo|]) == Abs [absdir|/foo/bar|]+--+mapSomeBase :: (forall b . Path b t -> Path b t') -> SomeBase t -> SomeBase t'+mapSomeBase f = \case+  Abs a -> Abs $ f a+  Rel r -> Rel $ f r++-- | Convert a valid path to a PLATFORM_PATH_SINGLE.+fromSomeBase :: SomeBase t -> PLATFORM_PATH+fromSomeBase = prjSomeBase toOsPath++-- | Convert a valid directory to a PLATFORM_PATH_SINGLE.+fromSomeDir :: SomeBase Dir -> PLATFORM_PATH+fromSomeDir = fromSomeBase++-- | Convert a valid file to a PLATFORM_PATH_SINGLE.+fromSomeFile :: SomeBase File -> PLATFORM_PATH+fromSomeFile = fromSomeBase++-- | Convert an absolute or relative PLATFORM_PATH_SINGLE to a normalized 'SomeBase'+-- representing a directory.+--+-- Throws: 'InvalidDir' when the supplied path:+--+-- * contains a @..@ path component representing the parent directory+-- * is not a valid path (See 'OsPath.isValid')+parseSomeDir :: MonadThrow m => PLATFORM_PATH -> m (SomeBase Dir)+parseSomeDir fp = maybe (throwM (InvalidDir fp)) pure+                $ (Abs <$> parseAbsDir fp)+              <|> (Rel <$> parseRelDir fp)++-- | Convert an absolute or relative PLATFORM_PATH_SINGLE to a normalized 'SomeBase'+-- representing a file.+--+-- Throws: 'InvalidFile' when the supplied path:+--+-- * is a directory path i.e.+--+--     * has a trailing path separator+--     * is @.@ or ends in @/.@+--+-- * contains a @..@ path component representing the parent directory+-- * is not a valid path (See 'OsPath.isValid')+parseSomeFile :: MonadThrow m => PLATFORM_PATH -> m (SomeBase File)+parseSomeFile fp = maybe (throwM (InvalidFile fp)) pure+                 $ (Abs <$> parseAbsFile fp)+               <|> (Rel <$> parseRelFile fp)++--------------------------------------------------------------------------------+-- Deprecated++-- | Add extension to given file path. Throws if the+-- resulting filename does not parse.+--+-- >>> addFileExtension [pstr|txt|] $(mkRelFile "foo")+-- "foo.txt"+-- >>> addFileExtension [pstr|symbols|] $(mkRelFile "Data.List")+-- "Data.List.symbols"+-- >>> addFileExtension [pstr|.symbols|] $(mkRelFile "Data.List")+-- "Data.List.symbols"+-- >>> addFileExtension [pstr|symbols|] $(mkRelFile "Data.List.")+-- "Data.List..symbols"+-- >>> addFileExtension [pstr|.symbols|] $(mkRelFile "Data.List.")+-- "Data.List..symbols"+-- >>> addFileExtension [pstr|evil/|] $(mkRelFile "Data.List")+-- *** Exception: InvalidRelFile "Data.List.evil/"+--+-- @since 0.6.1+{-# DEPRECATED addFileExtension "Please use addExtension instead." #-}+addFileExtension :: MonadThrow m+  => PLATFORM_STRING   -- ^ Extension to add+  -> Path b File       -- ^ Old file name+  -> m (Path b File)   -- ^ New file name with the desired extension added at the end+addFileExtension ext (Path path) =+  if OsPath.isAbsolute path+    then coerce <$> parseAbsFile (OsPath.addExtension path ext)+    else coerce <$> parseRelFile (OsPath.addExtension path ext)++-- | A synonym for 'addFileExtension' in the form of an infix operator.+-- See more examples there.+--+-- >>> $(mkRelFile "Data.List") <.> [pstr|symbols|]+-- "Data.List.symbols"+-- >>> $(mkRelFile "Data.List") <.> [pstr|evil/|]+-- *** Exception: InvalidRelFile "Data.List.evil/"+--+-- @since 0.6.1+infixr 7 <.>+{-# DEPRECATED (<.>) "Please use addExtension instead." #-}+(<.>) :: MonadThrow m+  => Path b File       -- ^ Old file name+  -> PLATFORM_STRING   -- ^ Extension to add+  -> m (Path b File)   -- ^ New file name with the desired extension added at the end+(<.>) = flip addFileExtension++-- | Replace\/add extension to given file path. Throws if the+-- resulting filename does not parse.+--+-- @since 0.5.11+{-# DEPRECATED setFileExtension "Please use replaceExtension instead." #-}+setFileExtension :: MonadThrow m+  => PLATFORM_STRING   -- ^ Extension to set+  -> Path b File       -- ^ Old file name+  -> m (Path b File)   -- ^ New file name with the desired extension+setFileExtension ext (Path path) =+  if OsPath.isAbsolute path+    then coerce <$> parseAbsFile (OsPath.replaceExtension path ext)+    else coerce <$> parseRelFile (OsPath.replaceExtension path ext)++-- | A synonym for 'setFileExtension' in the form of an operator.+--+-- @since 0.6.0+infixr 7 -<.>+{-# DEPRECATED (-<.>) "Please use replaceExtension instead." #-}+(-<.>) :: MonadThrow m+  => Path b File       -- ^ Old file name+  -> PLATFORM_STRING   -- ^ Extension to set+  -> m (Path b File)   -- ^ New file name with the desired extension+(-<.>) = flip setFileExtension+++{-# DEPRECATED PathParseException "Please use PathException instead." #-}+-- | Same as 'PathException'.+type PathParseException = PathException++{-# DEPRECATED stripDir "Please use stripProperPrefix instead." #-}+-- | Same as 'stripProperPrefix'.+stripDir :: MonadThrow m+         => Path b Dir -> Path b t -> m (Path Rel t)+stripDir = stripProperPrefix++{-# DEPRECATED isParentOf "Please use isProperPrefixOf instead." #-}+-- | Same as 'isProperPrefixOf'.+isParentOf :: Path b Dir -> Path b t -> Bool+isParentOf = isProperPrefixOf
+ src/OsPath/Internal.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}++#if defined(mingw32_HOST_OS)+module OsPath.Internal(module OsPath.Internal.Windows) where+import OsPath.Internal.Windows+#else+module OsPath.Internal(module OsPath.Internal.Posix) where+import OsPath.Internal.Posix+#endif
+ src/OsPath/Internal/Include.hs view
@@ -0,0 +1,297 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows+--     PLATFORM_PATH = PosixPath | WindowsPath+--     PLATFORM_PATH_SINGLE = 'PosixPath' | 'WindowsPath'+--     IS_WINDOWS = 0 | 1++{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE QuasiQuotes         #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}++-- | Internal types and functions.++module OsPath.Internal.PLATFORM_NAME+  ( -- * The Path type+    Path(..)+  , toOsPath++    -- * Validation functions+  , isValidAbsDir+  , isValidAbsFile+  , isValidRelDir+  , isValidRelFile+  , hasParentDir++    -- * Normalizing functions+  , normalizeLeadingSeps+  , normalizeTrailingSeps+  , normalizeAllSeps+#if IS_WINDOWS+  , normalizeWindowsSeps+#endif+  , normalizeDrive+  , normalizeDir+  , normalizeFile++    -- * Other helper functions+  , extSep+  , pathSep+  , relRoot+  , isWindows+  )+  where++import Control.DeepSeq (NFData (..))+import GHC.Generics (Generic)+import Data.Data+import Data.Hashable+import qualified Language.Haskell.TH.Syntax as TH+import System.OsPath.PLATFORM_NAME (PLATFORM_PATH)+import qualified System.OsPath.PLATFORM_NAME as OsPath++import System.OsString.Compat.PLATFORM_NAME (PLATFORM_STRING)+import qualified System.OsString.Compat.PLATFORM_NAME as OsString++-- | Path of some base and type.+--+-- The type variables are:+--+--   * @b@ — base, the base location of the path; absolute or relative.+--   * @t@ — type, whether file or directory.+--+-- Internally it is a PLATFORM_PATH_SINGLE, which can be of two formats only:+--+-- 1. File format: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@+-- 2. Directory format: @foo\/@, @\/foo\/bar\/@+--+-- All directories end in a trailing separator. There are no duplicate+-- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc.+newtype Path b t = Path PLATFORM_PATH+  deriving (Data, Typeable, Generic)++-- | String equality.+--+-- The following property holds:+--+-- @show x == show y ≡ x == y@+instance Eq (Path b t) where+  (==) (Path x) (Path y) = x == y+  {-# INLINE (==) #-}++-- | String ordering.+--+-- The following property holds:+--+-- @show x \`compare\` show y ≡ x \`compare\` y@+instance Ord (Path b t) where+  compare (Path x) (Path y) = compare x y+  {-# INLINE compare #-}++-- | Same as 'show . OsPath.toOsPath'.+--+-- The following property holds:+--+-- @x == y ≡ show x == show y@+instance Show (Path b t) where+  show = show . toOsPath+  {-# INLINE show #-}++instance NFData (Path b t) where+  rnf (Path x) = rnf x+  {-# INLINE rnf #-}++instance Hashable (Path b t) where+  -- A "." is represented as an empty string ("") internally. Hashing ""+  -- results in a hash that is the same as the salt. To produce a more+  -- reasonable hash we use "toFilePath" before hashing so that a "" gets+  -- converted back to a ".".+  hashWithSalt n path = hashWithSalt n (toOsPath path)+  {-# INLINE hashWithSalt #-}++instance forall b t. (Typeable b, Typeable t) => TH.Lift (Path b t) where+  lift (Path str) = do+    let b = TH.ConT $ getTCName (Proxy :: Proxy b)+        t = TH.ConT $ getTCName (Proxy :: Proxy t)+    [| Path $(TH.lift str) :: Path $(pure b) $(pure t) |]+    where+      getTCName :: Typeable a => proxy a -> TH.Name+      getTCName a = TH.Name occ flav+        where+        tc   = typeRepTyCon (typeRep a)+        occ  = TH.OccName (tyConName tc)+        flav = TH.NameG TH.TcClsName (TH.PkgName (tyConPackage tc)) (TH.ModName (tyConModule tc))++#if MIN_VERSION_template_haskell(2,17,0)+  liftTyped = TH.unsafeCodeCoerce . TH.lift+#elif MIN_VERSION_template_haskell(2,16,0)+  liftTyped = TH.unsafeTExpCoerce . TH.lift+#endif++-- | Convert to a PLATFORM_PATH type.+--+-- All directories have a trailing slash, so if you want no trailing+-- slash, you can use 'OsPath.dropTrailingPathSeparator' from+-- the filepath package.+toOsPath :: Path b t -> PLATFORM_PATH+toOsPath (Path ospath)+    | OsString.null ospath = relRoot+    | otherwise = ospath++--------------------------------------------------------------------------------+-- Validation functions++-- | Is the PLATFORM_PATH_SINGLE a valid absolute dir?+isValidAbsDir :: PLATFORM_PATH -> Bool+isValidAbsDir ospath =+  OsPath.isAbsolute ospath &&+  not (hasParentDir ospath) &&+  OsPath.isValid ospath++-- | Is the PLATFORM_PATH_SINGLE a valid absolute file?+isValidAbsFile :: PLATFORM_PATH -> Bool+isValidAbsFile ospath =+  OsPath.isAbsolute ospath &&+  not (OsPath.hasTrailingPathSeparator ospath) &&+  not (hasParentDir ospath) &&+  OsPath.isValid ospath++-- | Is the PLATFORM_PATH_SINGLE a valid relative dir?+isValidRelDir :: PLATFORM_PATH -> Bool+isValidRelDir ospath =+  not (OsPath.isAbsolute ospath) &&+  not (OsString.null ospath) &&+  not (hasParentDir ospath) &&+  not (OsString.all OsPath.isPathSeparator ospath) &&+  OsPath.isValid ospath++-- | Is the PLATFORM_PATH_SINGLE a valid relative file?+isValidRelFile :: PLATFORM_PATH -> Bool+isValidRelFile ospath =+  not (OsPath.isAbsolute ospath) &&+  not (OsString.null ospath) &&+  not (hasParentDir ospath) &&+  not (OsPath.hasTrailingPathSeparator ospath) &&+  ospath /= [OsPath.pstr|.|] &&+  OsPath.isValid ospath++-- | Helper function: check if the filepath has any parent directories in it.+-- This handles the logic of checking for different path separators on Windows.+hasParentDir :: PLATFORM_PATH -> Bool+hasParentDir ospath =+     (ospath' == [OsString.pstr|..|]) ||+     (prefix' `OsString.isPrefixOf` ospath') ||+     (infix' `OsString.isInfixOf` ospath') ||+     (suffix' `OsString.isSuffixOf` ospath')+  where+    prefix' = [OsString.pstr|..|] <> pathSep+    infix' = pathSep <> [OsString.pstr|..|] <> pathSep+    suffix' = pathSep <> [OsString.pstr|..|]++#if IS_WINDOWS+    ospath' = OsString.map normSep ospath+    normSep c+      | OsPath.isPathSeparator c = OsPath.pathSeparator+      | otherwise = c+#else+    ospath' = ospath+#endif++--------------------------------------------------------------------------------+-- Normalizing functions++-- | Normalizes seps only at the beginning of a path.+normalizeLeadingSeps :: PLATFORM_PATH -> PLATFORM_PATH+normalizeLeadingSeps path = normLeadingSep <> rest+  where (leadingSeps, rest) = OsString.span OsPath.isPathSeparator path+        normLeadingSep+          | OsString.null leadingSeps = OsString.empty+          | otherwise = OsString.singleton OsPath.pathSeparator++-- | Normalizes seps only at the end of a path.+normalizeTrailingSeps :: PLATFORM_PATH -> PLATFORM_PATH+normalizeTrailingSeps path = rest <> normTrailingSep+  where (rest, trailingSeps) = OsString.spanEnd OsPath.isPathSeparator path+        normTrailingSep+          | OsString.null trailingSeps = OsString.empty+          | otherwise = OsString.singleton OsPath.pathSeparator++-- | Replaces consecutive path seps with single sep and replaces alt sep with+--   standard sep.+normalizeAllSeps :: PLATFORM_PATH -> PLATFORM_PATH+normalizeAllSeps = go OsString.empty+  where go !acc ospath+          | OsString.null ospath = acc+          | otherwise =+            let (leadingSeps, withoutLeadingSeps) =+                  OsString.span OsPath.isPathSeparator ospath+                (name, rest) =+                  OsString.break OsPath.isPathSeparator withoutLeadingSeps+                sep = if OsString.null leadingSeps+                      then OsString.empty+                      else OsString.singleton OsPath.pathSeparator+            in go (acc <> sep <> name) rest++#if IS_WINDOWS+-- | Normalizes seps in whole path, but if there are 2+ seps at the beginning,+--   they are normalized to exactly 2 to preserve UNC and Unicode prefixed+--   paths.+normalizeWindowsSeps :: PLATFORM_PATH -> PLATFORM_PATH+normalizeWindowsSeps path = normLeadingSeps <> normalizeAllSeps rest+  where (leadingSeps, rest) = OsString.span OsPath.isPathSeparator path+        normLeadingSeps = OsString.replicate+          (min 2 (OsString.length leadingSeps))+          OsPath.pathSeparator+#endif++-- | Normalizes the drive of a PLATFORM_PATH_SINGLE.+normalizeDrive :: PLATFORM_PATH -> PLATFORM_PATH+#if IS_WINDOWS+normalizeDrive = normalizeTrailingSeps+#else+normalizeDrive = id+#endif++-- | Normalizes directory path with platform-specific rules.+normalizeDir :: PLATFORM_PATH -> PLATFORM_PATH+normalizeDir =+      normalizeRelDir+    . OsPath.addTrailingPathSeparator+    . normalizeFile+  where -- Represent a "." in relative dir path as "" internally so that it+        -- composes without having to renormalize the path.+        normalizeRelDir p+          | p == relRoot = OsString.empty+          | otherwise = p++-- | Applies platform-specific sep normalization following @OsPath.normalise@.+normalizeFile :: PLATFORM_PATH -> PLATFORM_PATH+#if IS_WINDOWS+normalizeFile = normalizeWindowsSeps . OsPath.normalise+#else+normalizeFile = normalizeLeadingSeps . OsPath.normalise+#endif++--------------------------------------------------------------------------------+-- Other helper functions++extSep :: PLATFORM_STRING+extSep = $(TH.lift (OsString.singleton OsPath.extSeparator))++pathSep :: PLATFORM_STRING+pathSep = $(TH.lift (OsString.singleton OsPath.pathSeparator))++-- | Normalized file path representation for the relative path root+relRoot :: PLATFORM_PATH+relRoot =+  $(TH.lift ([OsPath.pstr|.|] <> OsString.singleton OsPath.pathSeparator))++isWindows :: Bool+#if IS_WINDOWS+isWindows = True+#else+isWindows = False+#endif+{-# INLINE isWindows #-}
+ src/OsPath/Internal/Posix.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME        Posix+#define PLATFORM_PATH        PosixPath+#define PLATFORM_PATH_SINGLE 'PosixPath'+#define PLATFORM_STRING      PosixString+#define IS_WINDOWS           0+#include "Include.hs"
+ src/OsPath/Internal/Windows.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME        Windows+#define PLATFORM_PATH        WindowsPath+#define PLATFORM_PATH_SINGLE 'WindowsPath'+#define PLATFORM_STRING      WindowsString+#define IS_WINDOWS           1+#include "Include.hs"
+ src/OsPath/Posix.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME        Posix+#define PLATFORM_PATH        PosixPath+#define PLATFORM_PATH_SINGLE 'PosixPath'+#define PLATFORM_STRING      PosixString+#define PLATFORM_UTF_CODEC   UTF8+#define IS_WINDOWS           0+#include "Include.hs"
+ src/OsPath/Windows.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME        Windows+#define PLATFORM_PATH        WindowsPath+#define PLATFORM_PATH_SINGLE 'WindowsPath'+#define PLATFORM_STRING      WindowsString+#define PLATFORM_UTF_CODEC   UTF16-LE+#define IS_WINDOWS           1+#include "Include.hs"
src/Path/Include.hs view
@@ -1,6 +1,5 @@ -- This template expects CPP definitions for: --     PLATFORM_NAME = Posix | Windows---     IS_WINDOWS    = False | True  -- | This library provides a well-typed representation of paths in a filesystem -- directory tree.@@ -483,8 +482,8 @@             xtn  = (takeWhile notSep . dropWhile isSep) rstr         in (reverse name, reverse xtn ++ trailingSeps)     normalizeDrive-        | IS_WINDOWS = normalizeTrailingSeps-        | otherwise  = id+      | isWindows = normalizeTrailingSeps+      | otherwise = id      (drv, pth)     = FilePath.splitDrive fpath     (dir, file)    = splitLast FilePath.isPathSeparator pth@@ -818,6 +817,16 @@           | p == relRootFP = ""           | otherwise = p +-- | Normalizes seps only at the beginning of a path.+normalizeLeadingSeps :: FilePath -> FilePath+normalizeLeadingSeps path = normLeadingSep ++ rest+  where (leadingSeps, rest) = span FilePath.isPathSeparator path+        normLeadingSep = replicate (min 1 (length leadingSeps)) FilePath.pathSeparator++-- | Normalizes seps only at the end of a path.+normalizeTrailingSeps :: FilePath -> FilePath+normalizeTrailingSeps = reverse . normalizeLeadingSeps . reverse+ -- | Replaces consecutive path seps with single sep and replaces alt sep with standard sep. normalizeAllSeps :: FilePath -> FilePath normalizeAllSeps = foldr normSeps []@@ -834,21 +843,11 @@   where (leadingSeps, rest) = span FilePath.isPathSeparator path         normLeadingSeps = replicate (min 2 (length leadingSeps)) FilePath.pathSeparator --- | Normalizes seps only at the beginning of a path.-normalizeLeadingSeps :: FilePath -> FilePath-normalizeLeadingSeps path = normLeadingSep ++ rest-  where (leadingSeps, rest) = span FilePath.isPathSeparator path-        normLeadingSep = replicate (min 1 (length leadingSeps)) FilePath.pathSeparator---- | Normalizes seps only at the end of a path.-normalizeTrailingSeps :: FilePath -> FilePath-normalizeTrailingSeps = reverse . normalizeLeadingSeps . reverse- -- | Applies platform-specific sep normalization following @FilePath.normalise@. normalizeFilePath :: FilePath -> FilePath normalizeFilePath-  | IS_WINDOWS = normalizeWindowsSeps . FilePath.normalise-  | otherwise  = normalizeLeadingSeps . FilePath.normalise+  | isWindows = normalizeWindowsSeps . FilePath.normalise+  | otherwise = normalizeLeadingSeps . FilePath.normalise  -- | Path of some type.  @t@ represents the type, whether file or -- directory.  Pattern match to find whether the path is absolute or
src/Path/Internal/Include.hs view
@@ -1,6 +1,6 @@ -- This template expects CPP definitions for: --     PLATFORM_NAME = Posix | Windows---     IS_WINDOWS    = False | True+--     IS_WINDOWS    = 0 | 1  {-# LANGUAGE CPP                #-} {-# LANGUAGE DeriveGeneric      #-}@@ -15,6 +15,7 @@   , relRootFP   , toFilePath   , hasParentDir+  , isWindows   )   where @@ -136,3 +137,11 @@ #elif MIN_VERSION_template_haskell(2,16,0)   liftTyped = TH.unsafeTExpCoerce . TH.lift #endif++isWindows :: Bool+#if IS_WINDOWS+isWindows = True+#else+isWindows = False+#endif+{-# INLINE isWindows #-}
src/Path/Internal/Posix.hs view
@@ -1,4 +1,4 @@ {-# LANGUAGE CPP #-} #define PLATFORM_NAME   Posix-#define IS_WINDOWS      False+#define IS_WINDOWS      0 #include "Include.hs"
src/Path/Internal/Windows.hs view
@@ -1,4 +1,4 @@ {-# LANGUAGE CPP #-} #define PLATFORM_NAME   Windows-#define IS_WINDOWS      True+#define IS_WINDOWS      1 #include "Include.hs"
src/Path/Posix.hs view
@@ -1,4 +1,3 @@ {-# LANGUAGE CPP #-} #define PLATFORM_NAME   Posix-#define IS_WINDOWS      False #include "Include.hs"
src/Path/Windows.hs view
@@ -1,4 +1,3 @@ {-# LANGUAGE CPP #-} #define PLATFORM_NAME   Windows-#define IS_WINDOWS      True #include "Include.hs"
+ test-ospath/Common/Include.hs view
@@ -0,0 +1,344 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows+--     PLATFORM_PATH = PosixPath | WindowsPath+--     PLATFORM_STRING = PosixString | WindowsString++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++-- | Test functions that are common to Posix and Windows+module Common.PLATFORM_NAME+  (spec+  ,parseFails+  ,parseSucceeds+  ,parserTest+  ) where++import Control.Applicative ((<|>))+import Control.Monad (forM_, void)+import Control.Monad.Catch (MonadThrow)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Maybe (fromJust, isNothing)+import System.OsPath.PLATFORM_NAME (PLATFORM_PATH)+import qualified System.OsPath.PLATFORM_NAME as OsPath+import Test.Hspec++import OsPath.PLATFORM_NAME+import OsPath.Internal.PLATFORM_NAME+import System.OsString.Compat.PLATFORM_NAME (PLATFORM_STRING)+import qualified System.OsString.Compat.PLATFORM_NAME as OsString++currentDir :: Path Rel Dir+currentDir = (fromJust . parseRelDir) [OsString.pstr|.|]++drives :: NonEmpty (Path Abs Dir)+drives = (fromJust . traverse parseAbsDir) drives_++relDir :: Path Rel Dir+relDir = (fromJust . parseRelDir) [OsString.pstr|directory|]++relFile :: Path Rel File+relFile = (fromJust . parseRelFile) [OsString.pstr|file|]++spec :: Spec+spec = do+  describe "Operations: (</>)" operationAppend+  describe "Operations: dirname" operationDirname+  describe "Operations: filename" operationFilename+  describe "Operations: parent" operationParent+  describe "Operations: toOsPath" operationToOsPath+  describe "Operations: isProperPrefixOf" operationIsProperPrefixOf+  describe "Operations: stripProperPrefix" operationStripProperPrefix+  describe "Operations: isDrive" operationIsDrive+  describe "Operations: splitDrive" operationSplitDrive+  describe "Operations: extensions" extensionOperations++-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+  it+    "dirname (relDir </> relDir) == dirname relDir"+    (dirname (relDir </> relDir) == dirname relDir)+  it+    "dirname \".\" == dirname \".\""+    (dirname currentDir == currentDir)++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "dirname (absDir </> relDir) == dirname relDir"+      (dirname (absDir </> relDir) == dirname relDir)+    it+      "dirname of a drive must be a Rel path"+      (isNothing (parseAbsDir . toOsPath . dirname $ drive))++-- | The 'filename' operation.+operationFilename :: Spec+operationFilename = do+  it+    "filename (relDir </> relFile) == filename relFile"+    (filename (relDir </> relFile) == filename relFile)++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "filename (absDir </> relFile) == filename relFile"+      (filename (absDir </> relFile) == filename relFile)++-- | The 'parent' operation.+operationParent :: Spec+operationParent = do+  it+    "parent relDir == \".\""+    (parent relDir == currentDir)+  it+    "parent \".\" == \".\""+    (parent currentDir == currentDir)++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "parent (absDir </> relDir) == absDir"+      (parent (absDir </> relDir) == absDir)+    it+      "parent \"/name\" == drive"+      (parent absDir == drive)+    it+      "parent drive == drive"+      (parent drive == drive)++-- | The 'splitDrive' operation.+operationSplitDrive :: Spec+operationSplitDrive = forDrives $ \drive -> do+  let absDir = drive </> relDir+      absFile = drive </> relFile+  it+    "splitDrive absDir == (drive, Just relDir)"+    (splitDrive absDir == (drive, Just relDir))+  it+    "splitDrive absFile == (drive, Just relFile)"+    (splitDrive absFile == (drive, Just relFile))+  it+    "splitDrive drive == (drive, Nothing)"+    (splitDrive drive == (drive, Nothing))++-- | The 'isDrive' operation.+operationIsDrive :: Spec+operationIsDrive = forDrives $ \drive -> do+  let absDir = drive </> relDir+  it+    "isDrive drive"+    (isDrive drive)+  it+    "not (isDrive absDir)"+    (not (isDrive absDir))++-- | The 'isProperPrefixOf' operation.+operationIsProperPrefixOf :: Spec+operationIsProperPrefixOf = do+  it+    "isProperPrefixOf relDir (relDir </> relDir)"+    (isProperPrefixOf relDir (relDir </> relDir))++  it+    "not (relDir `isProperPrefixOf` relDir)"+    (not (isProperPrefixOf relDir relDir))++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "isProperPrefixOf absDir (absDir </> relDir)"+      (isProperPrefixOf absDir (absDir </> relDir))++    it+      "not (drive `isProperPrefixOf` drive)"+      (not (isProperPrefixOf drive drive))++-- | The 'stripProperPrefix' operation.+operationStripProperPrefix :: Spec+operationStripProperPrefix = do+  it+    "stripProperPrefix relDir (relDir </> relDir) == Just relDir"+    (stripProperPrefix relDir (relDir </> relDir) == Just relDir)++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "stripProperPrefix absDir (absDir </> relDir) == Just relDir"+      (stripProperPrefix absDir (absDir </> relDir) == Just relDir)+    it+      "stripProperPrefix absDir absDir == Nothing"+      (isNothing (stripProperPrefix absDir absDir))++-- | The '</>' operation.+operationAppend :: Spec+operationAppend = do+  let Path relDir' = relDir+      Path relFile' = relFile+  it+    "RelDir + RelDir == RelDir"+     (relDir </> relDir == Path (relDir' OsPath.</> relDir'))+  it+    "\".\" + \".\" == \".\""+    (currentDir </> currentDir == currentDir)+  it+    "\".\" + relDir == relDir"+     (currentDir </> relDir == relDir)+  it+    "relDir + \".\" == x"+    (relDir </> currentDir == relDir)+  it+    "RelDir + RelFile == RelFile"+    (relDir </> relFile == Path (relDir' OsPath.</> relFile'))++  forDrives $ \drive -> do+    let absDir@(Path absDir') = drive </> relDir+    it+      "AbsDir + RelDir == AbsDir"+      (absDir </> relDir == Path (absDir' OsPath.</> relDir'))+    it+      "AbsDir + RelFile == AbsFile"+      (absDir </> relFile == Path (absDir' OsPath.</> relFile'))++-- | The 'toOsPath' operation.+operationToOsPath :: Spec+operationToOsPath = do+  let expected = relRoot+  it+    ("toOsPath \".\" == " ++ show expected)+    (toOsPath currentDir == expected)+  it+    ("show \".\" == " ++ (show . show) expected)+    (show currentDir == show expected)++-- | Testing operations related to extensions.+extensionOperations :: Spec+extensionOperations = do+    describe "Only filenames and extensions" $+      forM_ filenames $ \file -> do+        forM_ validExtensions $ \ext -> do+          runTests parseRelFile file ext++    describe "Relative dir paths" $+      forM_ dirnames $ \dir -> do+        forM_ filenames $ \file -> do+          forM_ validExtensions $ \ext -> do+              let ospath =+                    dir <> OsString.singleton OsPath.pathSeparator <> file+              runTests parseRelFile ospath ext++    describe "Absolute dir paths" $+      forM_ drives_ $ \drive -> do+        forM_ dirnames $ \dir -> do+          forM_ filenames $ \file -> do+            forM_ validExtensions $ \ext -> do+              let ospath = drive <> dir <> pathSep <> file+              runTests parseAbsFile ospath ext++    -- Invalid extensions+    forM_ invalidExtensions $ \ext -> do+      it ("throws InvalidExtension when extension is " ++ show ext)  $+         addExtension ext (Path [OsString.pstr|name|])+         `shouldThrow` (== InvalidExtension ext)++    where++    runTests :: (forall m . MonadThrow m => PLATFORM_PATH -> m (Path b File))+             -> PLATFORM_PATH+             -> PLATFORM_STRING+             -> Spec+    runTests parse file ext = do+        let maybePathFile = parse file+        let maybePathFileWithExt = parse (file <> ext)+        case (maybePathFile, maybePathFileWithExt) of+            (Just pathFile, Just pathFileWithExt) -> validExtensionsSpec ext pathFile pathFileWithExt+            _ -> it ("Files " ++ show file ++ " and/or " ++ show (file <> ext) ++ " should parse successfully.") $+                     expectationFailure $+                         show file ++ " parsed to " ++ show maybePathFile ++ ", "+                         ++ show (file <> ext) ++ " parsed to " ++ show maybePathFileWithExt++    filenames :: [PLATFORM_PATH]+    filenames =+        [ [OsString.pstr|name|]+        , [OsString.pstr|name.|]+        , [OsString.pstr|name..|]+        , [OsString.pstr|.name|]+        , [OsString.pstr|..name|]+        , [OsString.pstr|name.name|]+        , [OsString.pstr|name..name|]+        , [OsString.pstr|...|]+        ]++    dirnames :: [PLATFORM_PATH]+    dirnames = filenames ++ [ [OsString.pstr|.|] ]++    invalidExtensions :: [PLATFORM_STRING]+    invalidExtensions =+        [ [OsString.pstr||]+        , [OsString.pstr|.|]+        , [OsString.pstr|x|]+        , [OsString.pstr|..|]+        , [OsString.pstr|...|]+        , [OsString.pstr|xy|]+        , [OsString.pstr|foo|]+        , [OsString.pstr|foo.|]+        , [OsString.pstr|foo..|]+        , [OsString.pstr|..foo|]+        , [OsString.pstr|...foo|]+        , [OsString.pstr|.foo.bar|]+        , [OsString.pstr|.foo|] <> pathSep <> [OsString.pstr|bar|]+        ]++    validExtensions :: [PLATFORM_STRING]+    validExtensions =+        [ [OsString.pstr|.foo|]+        , [OsString.pstr|.foo.|]+        , [OsString.pstr|.foo..|]+        ]++validExtensionsSpec :: PLATFORM_STRING -> Path b File -> Path b File -> Spec+validExtensionsSpec ext file fext = do+    let f = show $ toOsPath file+    let fx = show $ toOsPath fext++    it ("addExtension " ++ show ext ++ " " ++ f ++ " == " ++ fx) $+        addExtension ext file `shouldReturn` fext++    it ("fileExtension " ++ fx ++ " == " ++ show ext) $+        fileExtension fext `shouldReturn` ext++    it ("replaceExtension " ++ show ext ++ " " ++ fx ++ " == " ++ fx) $+        replaceExtension ext fext `shouldReturn` fext++forDrives :: (Path Abs Dir -> Spec) -> Spec+forDrives f = case drives of+  (drive :| []) -> f drive+  _ -> forM_ drives $ \drive ->+    describe ("Drive " ++ show drive) (f drive)++parseFails :: PLATFORM_PATH -> Spec+parseFails x = it (show x ++ " should be rejected")+  (isNothing (void (parseAbsDir x) <|>+              void (parseRelDir x) <|>+              void (parseAbsFile x) <|>+              void (parseRelFile x)))++parseSucceeds :: PLATFORM_PATH -> Path Rel Dir -> Spec+parseSucceeds x with = parserTest parseRelDir x (Just with)++-- | Parser test.+parserTest :: (Show a, Show b, Eq b)+           => (a -> Maybe b) -> a -> Maybe b -> Spec+parserTest parser input expected =+  it (message1 ++ "Parsing " ++ show input ++ " " ++ message2)+     (parser input `shouldBe` expected)+  where message1+          | isNothing expected =  "Failing: "+          | otherwise = "Succeeding: "++        message2 = case expected of+          Nothing -> "should fail."+          Just x -> "should succeed with: " ++ show x
+ test-ospath/Common/Posix.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Posix+#define PLATFORM_PATH PosixPath+#define PLATFORM_STRING PosixString+#include "Include.hs"++drives_ :: NonEmpty PLATFORM_PATH+drives_ = NonEmpty.singleton [OsString.pstr|/|]
+ test-ospath/Common/Windows.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Windows+#define PLATFORM_PATH WindowsPath+#define PLATFORM_STRING WindowsString+#include "Include.hs"++-- See https://learn.microsoft.com/en-us/dotnet/standard/io/file-path-formats+drives_ :: NonEmpty PLATFORM_STRING+drives_ = NonEmpty.fromList+  [ [OsString.pstr|C:\|] -- Common+  , [OsString.pstr|C:/|] -- Common+  , [OsString.pstr|\\host|] -- UNC+  --, [OsString.pstr|\\.\C:\|] -- DOS Device Path+  , [OsString.pstr|\\?\C:\|] -- DOS Device Path+  --, [OsString.pstr|\\?\UNC\|] -- DOS Device Path+  --, [OsString.pstr|\\.\UNC\|] -- DOS Device Path+  ]
+ test-ospath/Main.hs view
@@ -0,0 +1,12 @@+module Main (main) where++import qualified Windows+import qualified Posix++import Test.Hspec++-- | Test suite entry point, returns exit failure if any test fails.+main :: IO ()+main = hspec $ do+    describe "Path.Windows" Windows.spec+    describe "Path.Posix" Posix.spec
+ test-ospath/Posix.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Test suite.++module Posix (spec) where++import Test.Hspec++import Common.Posix (parseFails, parseSucceeds, parserTest)+import qualified Common.Posix+import OsPath.Posix+import OsPath.Internal.Posix+import qualified System.OsString.Compat.Posix as OsString+import TH.Posix ()++-- | Test suite (Posix version).+spec :: Spec+spec =+  do describe "Parsing: Path Abs Dir" parseAbsDirSpec+     describe "Parsing: Path Rel Dir" parseRelDirSpec+     describe "Parsing: Path Abs File" parseAbsFileSpec+     describe "Parsing: Path Rel File" parseRelFileSpec+     Common.Posix.spec+     describe "Restrictions" restrictions+     describe "QuasiQuotes" quasiquotes++-- | Restricting the input of any tricks.+restrictions :: Spec+restrictions =+  do -- These ~ related ones below are now lifted:+     -- https://github.com/chrisdone/path/issues/19+     parseSucceeds [OsString.pstr|~/|] (Path [OsString.pstr|~/|])+     parseSucceeds [OsString.pstr|~/foo|] (Path [OsString.pstr|~/foo/|])+     parseSucceeds [OsString.pstr|~/foo/bar|] (Path [OsString.pstr|~/foo/bar/|])+     parseSucceeds [OsString.pstr|a..|] (Path [OsString.pstr|a../|])+     parseSucceeds [OsString.pstr|..a|] (Path [OsString.pstr|..a/|])+     --+     parseFails [OsString.pstr|../|]+     parseFails [OsString.pstr|..|]+     parseFails [OsString.pstr|/..|]+     parseFails [OsString.pstr|/foo/../bar/|]+     parseFails [OsString.pstr|/foo/bar/..|]++-- | Tests for the tokenizer.+parseAbsDirSpec :: Spec+parseAbsDirSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|./|]+     failing [OsString.pstr|foo.txt|]+     succeeding [OsString.pstr|/|] (Path [OsString.pstr|/|])+     succeeding [OsString.pstr|//|] (Path [OsString.pstr|/|])+     succeeding [OsString.pstr|///foo//bar//mu/|] (Path [OsString.pstr|/foo/bar/mu/|])+     succeeding [OsString.pstr|///foo//bar////mu|] (Path [OsString.pstr|/foo/bar/mu/|])+     succeeding [OsString.pstr|///foo//bar/.//mu|] (Path [OsString.pstr|/foo/bar/mu/|])++  where failing x = parserTest parseAbsDir x Nothing+        succeeding x with = parserTest parseAbsDir x (Just with)++-- | Tests for the tokenizer.+parseRelDirSpec :: Spec+parseRelDirSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|/|]+     failing [OsString.pstr|//|]+     succeeding [OsString.pstr|~/|] (Path [OsString.pstr|~/|]) -- https://github.com/chrisdone/path/issues/19+     failing [OsString.pstr|/|]+     succeeding [OsString.pstr|./|] (Path [OsString.pstr||])+     succeeding [OsString.pstr|././|] (Path [OsString.pstr||])+     failing [OsString.pstr|//|]+     failing [OsString.pstr|///foo//bar//mu/|]+     failing [OsString.pstr|///foo//bar////mu|]+     failing [OsString.pstr|///foo//bar/.//mu|]+     succeeding [OsString.pstr|...|] (Path [OsString.pstr|.../|])+     succeeding [OsString.pstr|foo.bak|] (Path [OsString.pstr|foo.bak/|])+     succeeding [OsString.pstr|./foo|] (Path [OsString.pstr|foo/|])+     succeeding [OsString.pstr|././foo|] (Path [OsString.pstr|foo/|])+     succeeding [OsString.pstr|./foo/./bar|] (Path [OsString.pstr|foo/bar/|])+     succeeding [OsString.pstr|foo//bar//mu//|] (Path [OsString.pstr|foo/bar/mu/|])+     succeeding [OsString.pstr|foo//bar////mu|] (Path [OsString.pstr|foo/bar/mu/|])+     succeeding [OsString.pstr|foo//bar/.//mu|] (Path [OsString.pstr|foo/bar/mu/|])++  where failing x = parserTest parseRelDir x Nothing+        succeeding x with = parserTest parseRelDir x (Just with)++-- | Tests for the tokenizer.+parseAbsFileSpec :: Spec+parseAbsFileSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|./|]+     failing [OsString.pstr|/.|]+     failing [OsString.pstr|/foo/bar/.|]+     failing [OsString.pstr|~/|]+     failing [OsString.pstr|./foo.txt|]+     failing [OsString.pstr|/|]+     failing [OsString.pstr|//|]+     failing [OsString.pstr|///foo//bar//mu/|]+     succeeding [OsString.pstr|/...|] (Path [OsString.pstr|/...|])+     succeeding [OsString.pstr|/foo.txt|] (Path [OsString.pstr|/foo.txt|])+     succeeding [OsString.pstr|///foo//bar////mu.txt|] (Path [OsString.pstr|/foo/bar/mu.txt|])+     succeeding [OsString.pstr|///foo//bar/.//mu.txt|] (Path [OsString.pstr|/foo/bar/mu.txt|])++  where failing x = parserTest parseAbsFile x Nothing+        succeeding x with = parserTest parseAbsFile x (Just with)++-- | Tests for the tokenizer.+parseRelFileSpec :: Spec+parseRelFileSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|/|]+     failing [OsString.pstr|//|]+     failing [OsString.pstr|~/|]+     failing [OsString.pstr|/|]+     failing [OsString.pstr|./|]+     failing [OsString.pstr|a/.|]+     failing [OsString.pstr|a/../b|]+     failing [OsString.pstr|a/..|]+     failing [OsString.pstr|../foo.txt|]+     failing [OsString.pstr|//|]+     failing [OsString.pstr|///foo//bar//mu/|]+     failing [OsString.pstr|///foo//bar////mu|]+     failing [OsString.pstr|///foo//bar/.//mu|]+     succeeding [OsString.pstr|a..|] (Path [OsString.pstr|a..|])+     succeeding [OsString.pstr|...|] (Path [OsString.pstr|...|])+     succeeding [OsString.pstr|foo.txt|] (Path [OsString.pstr|foo.txt|])+     succeeding [OsString.pstr|./foo.txt|] (Path [OsString.pstr|foo.txt|])+     succeeding [OsString.pstr|././foo.txt|] (Path [OsString.pstr|foo.txt|])+     succeeding [OsString.pstr|./foo/./bar.txt|] (Path [OsString.pstr|foo/bar.txt|])+     succeeding [OsString.pstr|foo//bar//mu.txt|] (Path [OsString.pstr|foo/bar/mu.txt|])+     succeeding [OsString.pstr|foo//bar////mu.txt|] (Path [OsString.pstr|foo/bar/mu.txt|])+     succeeding [OsString.pstr|foo//bar/.//mu.txt|] (Path [OsString.pstr|foo/bar/mu.txt|])++  where failing x = parserTest parseRelFile x Nothing+        succeeding x with = parserTest parseRelFile x (Just with)++-- | Test QuasiQuoters. Make sure they work the same as the $(mk*) constructors.+quasiquotes :: Spec+quasiquotes =+  do it "[absdir|/|] == $(mkAbsDir \"/\")"+       ([absdir|/|] `shouldBe` $(mkAbsDir [OsString.pstr|/|]))+     it "[absdir|/home|] == $(mkAbsDir \"/home\")"+       ([absdir|/home|] `shouldBe` $(mkAbsDir [OsString.pstr|/home|]))+     it "[reldir|foo|] == $(mkRelDir \"foo\")"+       ([reldir|foo|] `shouldBe` $(mkRelDir [OsString.pstr|foo|]))+     it "[reldir|foo/bar|] == $(mkRelDir \"foo/bar\")"+       ([reldir|foo/bar|] `shouldBe` $(mkRelDir [OsString.pstr|foo/bar|]))+     it "[absfile|/home/chris/foo.txt|] == $(mkAbsFile \"/home/chris/foo.txt\")"+       ([absfile|/home/chris/foo.txt|] `shouldBe` $(mkAbsFile [OsString.pstr|/home/chris/foo.txt|]))+     it "[relfile|foo|] == $(mkRelFile \"foo\")"+       ([relfile|foo|] `shouldBe` $(mkRelFile [OsString.pstr|foo|]))+     it "[relfile|chris/foo.txt|] == $(mkRelFile \"chris/foo.txt\")"+       ([relfile|chris/foo.txt|] `shouldBe` $(mkRelFile [OsString.pstr|chris/foo.txt|]))
+ test-ospath/TH/Posix.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Posix+#define PLATFORM_PATH PosixPath+#include "Include.hs"++qqAbsDir :: PLATFORM_PATH+qqAbsDir = checkInstantiated [absdir|/name/|]++qqAbsFile :: PLATFORM_PATH+qqAbsFile = checkInstantiated [absdir|/name|]++thAbsDir :: PLATFORM_PATH+thAbsDir = checkInstantiated $(mkAbsDir [OsString.pstr|/name/|])++thAbsFile :: PLATFORM_PATH+thAbsFile = checkInstantiated $(mkAbsFile [OsString.pstr|/name|])++liftAbsDir :: PLATFORM_PATH+liftAbsDir = checkInstantiated $(TH.lift (Path [OsString.pstr|/name/|] :: Path Abs Dir))++liftAbsFile :: PLATFORM_PATH+liftAbsFile = checkInstantiated $(TH.lift (Path [OsString.pstr|/name|] :: Path Abs File))
+ test-ospath/TH/Windows.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Windows+#define PLATFORM_PATH WindowsPath+#include "Include.hs"++qqAbsDir :: PLATFORM_PATH+qqAbsDir = checkInstantiated [absdir|C:\foo\|]++qqAbsFile :: PLATFORM_PATH+qqAbsFile = checkInstantiated [absdir|C:\foo|]++thAbsDir :: PLATFORM_PATH+thAbsDir = checkInstantiated $(mkAbsDir [OsString.pstr|C:\foo\|])++thAbsFile :: PLATFORM_PATH+thAbsFile = checkInstantiated $(mkAbsFile [OsString.pstr|C:\foo|])++liftAbsDir :: PLATFORM_PATH+liftAbsDir = checkInstantiated $(TH.lift (Path [OsString.pstr|C:\foo\|] :: Path Abs Dir))++liftAbsFile :: PLATFORM_PATH+liftAbsFile = checkInstantiated $(TH.lift (Path [OsString.pstr|C:\foo|] :: Path Abs File))
+ test-ospath/Windows.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE QuasiQuotes         #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}++-- | Test suite.++module Windows (spec) where++import Test.Hspec++import Common.Windows (parseFails, parseSucceeds, parserTest)+import qualified Common.Windows+import OsPath.Windows+import OsPath.Internal.Windows+import qualified System.OsString.Compat.Windows as OsString+import TH.Windows ()++-- | Test suite (Windows version).+spec :: Spec+spec =+  do describe "Parsing: Path Abs Dir" parseAbsDirSpec+     describe "Parsing: Path Rel Dir" parseRelDirSpec+     describe "Parsing: Path Abs File" parseAbsFileSpec+     describe "Parsing: Path Rel File" parseRelFileSpec+     Common.Windows.spec+     describe "Restrictions" restrictions+     describe "QuasiQuotes" quasiquotes++-- | Restricting the input of any tricks.+restrictions :: Spec+restrictions =+  do parseFails [OsString.pstr|..\|]+     parseFails [OsString.pstr|..|]+     parseSucceeds [OsString.pstr|a..|] (Path [OsString.pstr|a..\|])+     parseSucceeds [OsString.pstr|..a|] (Path [OsString.pstr|..a\|])+     parseFails [OsString.pstr|\..|]+     parseFails [OsString.pstr|C:\foo\..\bar\|]+     parseFails [OsString.pstr|C:\foo\bar\..|]++-- | Tests for the tokenizer.+parseAbsDirSpec :: Spec+parseAbsDirSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|.\|]+     failing [OsString.pstr|foo.txt|]+     failing [OsString.pstr|C:|]+     succeeding [OsString.pstr|C:\|] (Path [OsString.pstr|C:\|])+     succeeding [OsString.pstr|C:\\|] (Path [OsString.pstr|C:\|])+     succeeding [OsString.pstr|C:\\\foo\\bar\\mu\|] (Path [OsString.pstr|C:\foo\bar\mu\|])+     succeeding [OsString.pstr|C:\\\foo\\bar\\mu|] (Path [OsString.pstr|C:\foo\bar\mu\|])+     succeeding [OsString.pstr|C:\\\foo\\bar\.\\mu|] (Path [OsString.pstr|C:\foo\bar\mu\|])+     succeeding [OsString.pstr|\\unchost\share|] (Path [OsString.pstr|\\unchost\share\|])+     succeeding [OsString.pstr|\/unchost\share|] (Path [OsString.pstr|\\unchost\share\|])+     succeeding [OsString.pstr|\\unchost\share\\folder\|] (Path [OsString.pstr|\\unchost\share\folder\|])+     succeeding [OsString.pstr|\\?\C:\|] (Path [OsString.pstr|\\?\C:\|])+     succeeding [OsString.pstr|/\?\C:\|] (Path [OsString.pstr|\\?\C:\|])+     succeeding [OsString.pstr|\\?\C:\\\folder\\|] (Path [OsString.pstr|\\?\C:\folder\|])++  where failing x = parserTest parseAbsDir x Nothing+        succeeding x with = parserTest parseAbsDir x (Just with)++-- | Tests for the tokenizer.+parseRelDirSpec :: Spec+parseRelDirSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|/|]+     failing [OsString.pstr|//|]+     failing [OsString.pstr|\|]+     failing [OsString.pstr|\\|]+     failing [OsString.pstr|\\\foo\\bar\\mu\|]+     failing [OsString.pstr|\\\foo\\bar\\\\mu|]+     failing [OsString.pstr|\\\foo\\bar\.\\mu|]+     failing [OsString.pstr|\\unchost\share|]+     failing [OsString.pstr|\\?\C:\|]+     succeeding [OsString.pstr|.\|] (Path [OsString.pstr||])+     succeeding [OsString.pstr|.\.\|] (Path [OsString.pstr||])+     succeeding [OsString.pstr|...|] (Path [OsString.pstr|...\|])+     succeeding [OsString.pstr|foo.bak|] (Path [OsString.pstr|foo.bak\|])+     succeeding [OsString.pstr|.\foo|] (Path [OsString.pstr|foo\|])+     succeeding [OsString.pstr|.\.\foo|] (Path [OsString.pstr|foo\|])+     succeeding [OsString.pstr|.\foo\.\bar|] (Path [OsString.pstr|foo\bar\|])+     succeeding [OsString.pstr|foo\\bar\\mu\\|] (Path [OsString.pstr|foo\bar\mu\|])+     succeeding [OsString.pstr|foo\\bar////mu|] (Path [OsString.pstr|foo\bar\mu\|])+     succeeding [OsString.pstr|foo\\bar\.\\mu|] (Path [OsString.pstr|foo\bar\mu\|])++  where failing x = parserTest parseRelDir x Nothing+        succeeding x with = parserTest parseRelDir x (Just with)++-- | Tests for the tokenizer.+parseAbsFileSpec :: Spec+parseAbsFileSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|.\|]+     failing [OsString.pstr|\.|]+     failing [OsString.pstr|\foo\bar\.|]+     failing [OsString.pstr|~\|]+     failing [OsString.pstr|.\foo.txt|]+     failing [OsString.pstr|\|]+     failing [OsString.pstr|\\|]+     failing [OsString.pstr|\\\foo\\bar\\mu\|]+     failing [OsString.pstr|\...|]+     failing [OsString.pstr|\foo.txt|]+     succeeding [OsString.pstr|C:\\\foo\\bar\\\\mu.txt|] (Path [OsString.pstr|C:\foo\bar\mu.txt|])+     succeeding [OsString.pstr|C:\\\foo\\bar\.\\mu.txt|] (Path [OsString.pstr|C:\foo\bar\mu.txt|])+     succeeding [OsString.pstr|\\unchost\share\\file.txt|] (Path [OsString.pstr|\\unchost\share\file.txt|])+     succeeding [OsString.pstr|\/unchost\share\\file.txt|] (Path [OsString.pstr|\\unchost\share\file.txt|])+     succeeding [OsString.pstr|\\unchost\share\.\folder\\\file.txt|] (Path [OsString.pstr|\\unchost\share\folder\file.txt|])+     succeeding [OsString.pstr|\\?\C:\file.txt|] (Path [OsString.pstr|\\?\C:\file.txt|])+     succeeding [OsString.pstr|/\?\C:\file.txt|] (Path [OsString.pstr|\\?\C:\file.txt|])+     succeeding [OsString.pstr|\\?\C:\\\folder\.\\file.txt|] (Path [OsString.pstr|\\?\C:\folder\file.txt|])++  where failing x = parserTest parseAbsFile x Nothing+        succeeding x with = parserTest parseAbsFile x (Just with)++-- | Tests for the tokenizer.+parseRelFileSpec :: Spec+parseRelFileSpec =+  do failing [OsString.pstr||]+     failing [OsString.pstr|\|]+     failing [OsString.pstr|\\|]+     failing [OsString.pstr|~\|]+     failing [OsString.pstr|\|]+     failing [OsString.pstr|.\|]+     failing [OsString.pstr|a\.|]+     failing [OsString.pstr|a\..\b|]+     failing [OsString.pstr|a\..|]+     failing [OsString.pstr|..\foo.txt|]+     failing [OsString.pstr|\\|]+     failing [OsString.pstr|\\\foo\\bar\\mu\|]+     failing [OsString.pstr|\\\foo\\bar\\\\mu|]+     failing [OsString.pstr|\\\foo\\bar\.\\mu|]+     failing [OsString.pstr|\\unchost\share\\file.txt|]+     failing [OsString.pstr|\\?\C:\file.txt|]+     succeeding [OsString.pstr|a..|] (Path [OsString.pstr|a..|])+     succeeding [OsString.pstr|...|] (Path [OsString.pstr|...|])+     succeeding [OsString.pstr|foo.txt|] (Path [OsString.pstr|foo.txt|])+     succeeding [OsString.pstr|.\foo.txt|] (Path [OsString.pstr|foo.txt|])+     succeeding [OsString.pstr|.\.\foo.txt|] (Path [OsString.pstr|foo.txt|])+     succeeding [OsString.pstr|.\foo\.\bar.txt|] (Path [OsString.pstr|foo\bar.txt|])+     succeeding [OsString.pstr|foo\\bar\\mu.txt|] (Path [OsString.pstr|foo\bar\mu.txt|])+     succeeding [OsString.pstr|foo\\bar\\\\mu.txt|] (Path [OsString.pstr|foo\bar\mu.txt|])+     succeeding [OsString.pstr|foo\\bar\.\\mu.txt|] (Path [OsString.pstr|foo\bar\mu.txt|])++  where failing x = parserTest parseRelFile x Nothing+        succeeding x with = parserTest parseRelFile x (Just with)++-- | Test QuasiQuoters. Make sure they work the same as the $(mk*) constructors.+quasiquotes :: Spec+quasiquotes =+  do it "[absdir|C:\\|] == $(mkAbsDir \"C:\\\")"+       ([absdir|C:\|] `shouldBe` $(mkAbsDir [OsString.pstr|C:\|]))+     it "[absdir|C:\\chris\\|] == $(mkAbsDir \"C:\\chris\\\")"+       ([absdir|C:\chris\|] `shouldBe` $(mkAbsDir [OsString.pstr|C:\chris\|]))+     it "[reldir|foo|] == $(mkRelDir \"foo\")"+       ([reldir|foo|] `shouldBe` $(mkRelDir [OsString.pstr|foo|]))+     it "[reldir|foo\\bar|] == $(mkRelDir \"foo\\bar\")"+       ([reldir|foo\bar|] `shouldBe` $(mkRelDir [OsString.pstr|foo\bar|]))+     it "[absfile|C:\\chris\\foo.txt|] == $(mkAbsFile \"C:\\chris\\foo.txt\")"+       ([absfile|C:\chris\foo.txt|] `shouldBe` $(mkAbsFile [OsString.pstr|C:\chris\foo.txt|]))+     it "[relfile|foo.exe|] == $(mkRelFile \"foo.exe\")"+       ([relfile|foo.exe|] `shouldBe` $(mkRelFile [OsString.pstr|foo.exe|]))+     it "[relfile|chris\\foo.txt|] == $(mkRelFile \"chris\\foo.txt\")"+       ([relfile|chris\foo.txt|] `shouldBe` $(mkRelFile [OsString.pstr|chris\foo.txt|]))
test/Common/Include.hs view
@@ -1,93 +1,246 @@ -- This template expects CPP definitions for: --     PLATFORM_NAME = Posix | Windows---     IS_WINDOWS    = False | True -{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}  -- | Test functions that are common to Posix and Windows+module Common.PLATFORM_NAME+  (spec+  ,parseFails+  ,parseSucceeds+  ,parserTest+  ) where -module Common.PLATFORM_NAME (extensionOperations) where+import Control.Applicative ((<|>))+import Control.Monad (forM_, void)+import Control.Monad.Catch (MonadThrow)+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Maybe (fromJust, isNothing)+import qualified System.FilePath.PLATFORM_NAME as FilePath+import Test.Hspec -import Control.Monad-import qualified Language.Haskell.TH.Syntax as TH import Path.Internal.PLATFORM_NAME import Path.PLATFORM_NAME-import System.FilePath.PLATFORM_NAME (pathSeparator)-import Test.Hspec -class Foo a b where-    foo :: Path a b -> FilePath-    foo = toFilePath+currentDir :: Path Rel Dir+currentDir = (fromJust . parseRelDir) "." -instance Foo Abs Dir-instance Foo Abs File-instance Foo Rel Dir-instance Foo Rel File+drives :: NonEmpty (Path Abs Dir)+drives = (fromJust . traverse parseAbsDir) drives_ -qqRelDir :: FilePath-qqRelDir = foo [reldir|foo/|]+relDir :: Path Rel Dir+relDir = (fromJust . parseRelDir) "directory" -qqRelFile :: FilePath-qqRelFile = foo [relfile|foo|]+relFile :: Path Rel File+relFile = (fromJust . parseRelFile) "file" -thRelDir :: FilePath-thRelDir = foo $(mkRelDir "foo/")+spec :: Spec+spec = do+  describe "Operations: (</>)" operationAppend+  describe "Operations: dirname" operationDirname+  describe "Operations: filename" operationFilename+  describe "Operations: parent" operationParent+  describe "Operations: toFilePath" operationToFilePath+  describe "Operations: isProperPrefixOf" operationIsProperPrefixOf+  describe "Operations: stripProperPrefix" operationStripProperPrefix+  describe "Operations: isDrive" operationIsDrive+  describe "Operations: splitDrive" operationSplitDrive+  describe "Operations: extensions" extensionOperations -thRelFile :: FilePath-thRelFile = foo $(mkRelFile "foo")+-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+  it+    "dirname (relDir </> relDir) == dirname relDir"+    (dirname (relDir </> relDir) == dirname relDir)+  it+    "dirname \".\" == dirname \".\""+    (dirname currentDir == currentDir) -liftRelDir :: FilePath-liftRelDir = foo $(TH.lift (Path "foo/" :: Path Rel Dir))+  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "dirname (absDir </> relDir) == dirname relDir"+      (dirname (absDir </> relDir) == dirname relDir)+    it+      "dirname of a drive must be a Rel path"+      (isNothing (parseAbsDir . toFilePath . dirname $ drive)) -liftRelFile :: FilePath-liftRelFile = foo $(TH.lift (Path "foo" :: Path Rel File))+-- | The 'filename' operation.+operationFilename :: Spec+operationFilename = do+  it+    "filename (relDir </> relFile) == filename relFile"+    (filename (relDir </> relFile) == filename relFile) -validExtensionsSpec :: String -> Path b File -> Path b File -> Spec-validExtensionsSpec ext file fext = do-    let f = show $ toFilePath file-    let fx = show $ toFilePath fext+  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "filename (absDir </> relFile) == filename relFile"+      (filename (absDir </> relFile) == filename relFile) -    it ("addExtension " ++ show ext ++ " " ++ f ++ " == " ++ fx) $-        addExtension ext file `shouldReturn` fext+-- | The 'parent' operation.+operationParent :: Spec+operationParent = do+  it+    "parent relDir == \".\""+    (parent relDir == currentDir)+  it+    "parent \".\" == \".\""+    (parent currentDir == currentDir) -    it ("fileExtension " ++ fx ++ " == " ++ ext) $-        fileExtension fext `shouldReturn` ext+  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "parent (absDir </> relDir) == absDir"+      (parent (absDir </> relDir) == absDir)+    it+      "parent absDir == drive"+      (parent absDir == drive)+    it+      "parent drive == drive"+      (parent drive == drive) -    it ("replaceExtension " ++ show ext ++ " " ++ fx ++ " == " ++ fx) $-        replaceExtension ext fext `shouldReturn` fext+-- | The 'splitDrive' operation.+operationSplitDrive :: Spec+operationSplitDrive = forDrives $ \drive -> do+  let absDir = drive </> relDir+      absFile = drive </> relFile+  it+    "splitDrive absDir == (drive, Just relDir)"+    (splitDrive absDir == (drive, Just relDir))+  it+    "splitDrive absFile == (drive, Just relFile)"+    (splitDrive absFile == (drive, Just relFile))+  it+    "splitDrive drive == (drive, Nothing)"+    (splitDrive drive == (drive, Nothing)) -extensionOperations :: String -> Spec-extensionOperations rootDrive = do-    let extension = ".foo"-    let extensions = extension : [".foo.", ".foo.."]+-- | The 'isDrive' operation.+operationIsDrive :: Spec+operationIsDrive = forDrives $ \drive -> do+  let absDir = drive </> relDir+  it+    "isDrive drive"+    (isDrive drive)+  it+    "not (isDrive absDir)"+    (not (isDrive absDir)) +-- | The 'isProperPrefixOf' operation.+operationIsProperPrefixOf :: Spec+operationIsProperPrefixOf = do+  it+    "isProperPrefixOf relDir (relDir </> relDir)"+    (isProperPrefixOf relDir (relDir </> relDir))++  it+    "not (relDir `isProperPrefixOf` relDir)"+    (not (isProperPrefixOf relDir relDir))++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "isProperPrefixOf absDir (absDir </> relDir)"+      (isProperPrefixOf absDir (absDir </> relDir))++    it+      "not (drive `isProperPrefixOf` drive)"+      (not (isProperPrefixOf drive drive))++-- | The 'stripProperPrefix' operation.+operationStripProperPrefix :: Spec+operationStripProperPrefix = do+  it+    "stripProperPrefix relDir (relDir </> relDir) == relDir"+    (stripProperPrefix relDir (relDir </> relDir) == Just relDir)++  forDrives $ \drive -> do+    let absDir = drive </> relDir+    it+      "stripProperPrefix absDir (absDir </> relDir) == relDir"+      (stripProperPrefix absDir (absDir </> relDir) == Just relDir)+    it+      "stripProperPrefix absDir absDir == Nothing"+      (isNothing (stripProperPrefix absDir absDir))++-- | The '</>' operation.+operationAppend :: Spec+operationAppend = do+  let Path relDir' = relDir+      Path relFile' = relFile+  it+    "RelDir + RelDir == RelDir"+     (relDir </> relDir == Path (relDir' FilePath.</> relDir'))+  it+    "\".\" + \".\" == \".\""+    (currentDir </> currentDir == currentDir)+  it+    "\".\" + relDir == relDir"+     (currentDir </> relDir == relDir)+  it+    "relDir + \".\" == x"+    (relDir </> currentDir == relDir)+  it+    "RelDir + RelFile == RelFile"+    (relDir </> relFile == Path (relDir' FilePath.</> relFile'))++  forDrives $ \drive -> do+    let absDir@(Path absDir') = drive </> relDir+    it+      "AbsDir + RelDir == AbsDir"+      (absDir </> relDir == Path (absDir' FilePath.</> relDir'))+    it+      "AbsDir + RelFile == AbsFile"+      (absDir </> relFile == Path (absDir' FilePath.</> relFile'))++-- | The 'toFilePath operation.+operationToFilePath :: Spec+operationToFilePath = do+  let expected = "." ++ [FilePath.pathSeparator]+  it+    ("toFilePath \".\" == " ++ show expected)+    (toFilePath currentDir == expected)+  it+    ("show \".\" == " ++ (show . show) expected)+    (show currentDir == show expected)++-- | Testing operations related to extensions.+extensionOperations :: Spec+extensionOperations = do     describe "Only filenames and extensions" $-      forM_ extensions $ \ext ->-          forM_ filenames $ \f -> do-              runTests parseRelFile f ext+      forM_ filenames $ \file -> do+        forM_ validExtensions $ \ext -> do+          runTests parseRelFile file ext      describe "Relative dir paths" $-      forM_ dirnames $ \d -> do-          forM_ filenames $ \f -> do-              let f1 = d ++ [pathSeparator] ++ f-              runTests parseRelFile f1 extension+      forM_ dirnames $ \dir -> do+        forM_ filenames $ \file -> do+          forM_ validExtensions $ \ext -> do+              let filepath = dir ++ [FilePath.pathSeparator] ++ file+              runTests parseRelFile filepath ext      describe "Absolute dir paths" $-      forM_ dirnames $ \d -> do-          forM_ filenames $ \f -> do-              let f1 = rootDrive ++ d ++ [pathSeparator] ++ f-              runTests parseAbsFile f1 extension+      forM_ drives_ $ \drive -> do+        forM_ dirnames $ \dir -> do+          forM_ filenames $ \file -> do+            forM_ validExtensions $ \ext -> do+              let filepath = drive ++ dir ++ [FilePath.pathSeparator] ++ file+              runTests parseAbsFile filepath ext      -- Invalid extensions     forM_ invalidExtensions $ \ext -> do-        it ("throws InvalidExtension when extension is [" ++ ext ++ "]")  $-            addExtension ext $(mkRelFile "name")-            `shouldThrow` (== InvalidExtension ext)+      it ("throws InvalidExtension when extension is " ++ show ext) $+         addExtension ext (Path "name")+         `shouldThrow` (== InvalidExtension ext)      where +    runTests :: (forall m . MonadThrow m => FilePath -> m (Path b File))+             -> FilePath+             -> FilePath+             -> Spec     runTests parse file ext = do         let maybePathFile = parse file         let maybePathFileWithExt = parse (file ++ ext)@@ -98,6 +251,7 @@                          show file ++ " parsed to " ++ show maybePathFile ++ ", "                          ++ show (file ++ ext) ++ " parsed to " ++ show maybePathFileWithExt +    filenames :: [FilePath]     filenames =         [ "name"         , "name."@@ -108,7 +262,11 @@         , "name..name"         , "..."         ]++    dirnames :: [FilePath]     dirnames = filenames ++ ["."]++    invalidExtensions :: [String]     invalidExtensions =         [ ""         , "."@@ -122,5 +280,56 @@         , "..foo"         , "...foo"         , ".foo.bar"-        , ".foo" ++ [pathSeparator] ++ "bar"+        , ".foo" ++ [FilePath.pathSeparator] ++ "bar"         ]++    validExtensions :: [String]+    validExtensions =+        [ ".foo"+        , ".foo."+        , ".foo.."+        ]++validExtensionsSpec :: String -> Path b File -> Path b File -> Spec+validExtensionsSpec ext file fext = do+    let f = show $ toFilePath file+    let fx = show $ toFilePath fext++    it ("addExtension " ++ show ext ++ " " ++ f ++ " == " ++ fx) $+        addExtension ext file `shouldReturn` fext++    it ("fileExtension " ++ fx ++ " == " ++ ext) $+        fileExtension fext `shouldReturn` ext++    it ("replaceExtension " ++ show ext ++ " " ++ fx ++ " == " ++ fx) $+        replaceExtension ext fext `shouldReturn` fext++forDrives :: (Path Abs Dir -> Spec) -> Spec+forDrives f = case drives of+  (drive :| []) -> f drive+  _ -> forM_ drives $ \drive ->+    describe ("Drive " ++ show drive) (f drive)++parseFails :: FilePath -> Spec+parseFails x = it (show x ++ " should be rejected")+  (isNothing (void (parseAbsDir x) <|>+              void (parseRelDir x) <|>+              void (parseAbsFile x) <|>+              void (parseRelFile x)))++parseSucceeds :: FilePath -> Path Rel Dir -> Spec+parseSucceeds x with = parserTest parseRelDir x (Just with)++-- | Parser test.+parserTest :: (Show a, Show b, Eq b)+           => (a -> Maybe b) -> a -> Maybe b -> Spec+parserTest parser input expected =+  it (message1 ++ "Parsing " ++ show input ++ " " ++ message2)+     (parser input `shouldBe` expected)+  where message1+          | isNothing expected =  "Failing: "+          | otherwise = "Succeeding: "++        message2 = case expected of+          Nothing -> "should fail."+          Just x -> "should succeed with: " ++ show x
test/Common/Posix.hs view
@@ -1,24 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE QuasiQuotes #-} -#define PLATFORM_NAME   Posix-#define IS_WINDOWS      False+#define PLATFORM_NAME Posix #include "Include.hs" -qqAbsDir :: FilePath-qqAbsDir = foo [absdir|/foo/|]--qqAbsFile :: FilePath-qqAbsFile = foo [absdir|/foo|]--thAbsDir :: FilePath-thAbsDir = foo $(mkAbsDir "/foo/")--thAbsFile :: FilePath-thAbsFile = foo $(mkAbsFile "/foo")--liftAbsDir :: FilePath-liftAbsDir = foo $(TH.lift (Path "/foo/" :: Path Abs Dir))--liftAbsFile :: FilePath-liftAbsFile = foo $(TH.lift (Path "/foo" :: Path Abs File))+drives_ :: NonEmpty FilePath+drives_ = NonEmpty.singleton "/"
test/Common/Windows.hs view
@@ -1,24 +1,16 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE QuasiQuotes #-}-#define PLATFORM_NAME   Windows-#define IS_WINDOWS      True-#include "Include.hs" -qqAbsDir :: FilePath-qqAbsDir = foo [absdir|C:\foo\|]--qqAbsFile :: FilePath-qqAbsFile = foo [absdir|C:\foo|]--thAbsDir :: FilePath-thAbsDir = foo $(mkAbsDir "C:\\foo\\")--thAbsFile :: FilePath-thAbsFile = foo $(mkAbsFile "C:\\foo")--liftAbsDir :: FilePath-liftAbsDir = foo $(TH.lift (Path "C:\\foo\\" :: Path Abs Dir))--liftAbsFile :: FilePath-liftAbsFile = foo $(TH.lift (Path "C:\\foo" :: Path Abs File))+#define PLATFORM_NAME Windows+#include "Include.hs" +-- See https://learn.microsoft.com/en-us/dotnet/standard/io/file-path-formats+drives_ :: NonEmpty FilePath+drives_ = NonEmpty.fromList+  [ "C:\\" -- Common+  , "C:/" -- Common+  , "\\\\host" -- UNC+  --, "\\\\.\\C:\\" -- DOS Device Path+  , "\\\\?\\C:\\" -- DOS Device Path+  --, "\\\\?\\UNC\\" -- DOS Device Path+  --, "\\\\.\\UNC\\" -- DOS Device Path+  ]
− test/Path/Gen.hs 
@@ -1,127 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Path.Gen where--import Data.Functor-import Prelude--import Path-import Path.Internal--import qualified System.FilePath as FilePath--import Data.GenValidity-import Data.List (isSuffixOf, isInfixOf)-import Data.Maybe (isJust, mapMaybe)--import Test.QuickCheck--instance Validity (Path Abs File) where-  validate p@(Path fp) =-    mconcat-      [ validateCommon p,-        validateAbs p,-        validateFile p,-        declare "The path can be identically parsed as an absolute file path." $-          parseAbsFile fp == Just p-      ]--instance Validity (Path Rel File) where-  validate p@(Path fp) =-    mconcat-      [ validateCommon p,-        validateRel p,-        validateFile p,-        declare "The path can be identically parsed as a relative file path." $-          parseRelFile fp == Just p-      ]--instance Validity (Path Abs Dir) where-  validate p@(Path fp) =-    mconcat-      [ validateCommon p,-        validateAbs p,-        validateDirectory p,-        declare "The path can be identically parsed as an absolute directory path." $-          parseAbsDir fp == Just p-      ]--instance Validity (Path Rel Dir) where-  validate p@(Path fp) =-    mconcat-      [ validateCommon p,-        validateRel p,-        validateDirectory p,-        declare "The path can be identically parsed as a relative directory path if it's not empty." $-          parseRelDir fp == Just p || fp == ""-      ]--instance Validity (SomeBase Dir)--instance Validity (SomeBase File)--validateCommon :: Path b t -> Validation-validateCommon (Path fp) = mconcat-  [ declare "System.FilePath considers the path valid if it's not empty." $ FilePath.isValid fp || fp == ""-  , declare "The path does not contain a '..' path component." $ not (hasParentDir fp)-  ]--validateDirectory :: Path b Dir -> Validation-validateDirectory (Path fp) = mconcat-  [ declare "The path has a trailing path separator if it's not empty." $ FilePath.hasTrailingPathSeparator fp || fp == ""-  ]--validateFile :: Path b File -> Validation-validateFile (Path fp) = mconcat-  [ declare "The path has no trailing path separator." $ not (FilePath.hasTrailingPathSeparator fp)-  , declare "The path does not equal \".\"" $ fp /= "."-  , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)-  ]--validateAbs :: Path Abs t -> Validation-validateAbs (Path fp) = mconcat-  [ declare "The path is absolute." $ FilePath.isAbsolute fp-  ]--validateRel :: Path Rel t -> Validation-validateRel (Path fp) = mconcat-  [ declare "The path is relative." $ FilePath.isRelative fp-  ]--instance GenValid (Path Abs File) where-  genValid = (Path . ('/' :) <$> genFilePath) `suchThat` isValid-  shrinkValid = filter isValid . shrinkValidWith parseAbsFile--instance GenValid (Path Abs Dir) where-  genValid = (Path . ('/' :) . (++ "/") <$> genFilePath) `suchThat` isValid-  shrinkValid = filter isValid . shrinkValidWith parseAbsDir--instance GenValid (Path Rel File) where-  genValid = (Path <$> genFilePath) `suchThat` isValid-  shrinkValid = filter isValid . shrinkValidWith parseRelFile--instance GenValid (Path Rel Dir) where-  genValid = (Path . (++ "/") <$> genFilePath) `suchThat` isValid-  shrinkValid = filter isValid . shrinkValidWith parseRelDir--instance GenValid (SomeBase Dir) where-  genValid = genValidStructurallyWithoutExtraChecking-  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering--instance GenValid (SomeBase File) where-  genValid = genValidStructurallyWithoutExtraChecking-  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering---- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and--- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to--- be valid.-genFilePath :: Gen FilePath-genFilePath = listOf genPathyChar--genPathyChar :: Gen Char-genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")]--shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]-shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkValid f
test/Posix.hs view
@@ -7,16 +7,15 @@  module Posix (spec) where -import Control.Applicative-import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Maybe-import Path.Posix-import Path.Internal.Posix import Test.Hspec -import Common.Posix (extensionOperations)+import Common.Posix (parseFails, parseSucceeds, parserTest)+import qualified Common.Posix+import Path.Posix+import Path.Internal.Posix+import TH.Posix ()  -- | Test suite (Posix version). spec :: Spec@@ -25,16 +24,7 @@      describe "Parsing: Path Rel Dir" parseRelDirSpec      describe "Parsing: Path Abs File" parseAbsFileSpec      describe "Parsing: Path Rel File" parseRelFileSpec-     describe "Operations: (</>)" operationAppend-     describe "Operations: toFilePath" operationToFilePath-     describe "Operations: stripProperPrefix" operationStripProperPrefix-     describe "Operations: isProperPrefixOf" operationIsProperPrefixOf-     describe "Operations: parent" operationParent-     describe "Operations: splitDrive" operationSplitDrive-     describe "Operations: isDrive" operationIsDrive-     describe "Operations: filename" operationFilename-     describe "Operations: dirname" operationDirname-     describe "Operations: extensions" (extensionOperations "/")+     Common.Posix.spec      describe "Restrictions" restrictions      describe "Aeson Instances" aesonInstances      describe "QuasiQuotes" quasiquotes@@ -55,152 +45,7 @@      parseFails "/.."      parseFails "/foo/../bar/"      parseFails "/foo/bar/.."-  where parseFails x =-          it (show x ++ " should be rejected")-             (isNothing (void (parseAbsDir x) <|>-                         void (parseRelDir x) <|>-                         void (parseAbsFile x) <|>-                         void (parseRelFile x)))-        parseSucceeds x with =-          parserTest parseRelDir x (Just with) --- | The 'dirname' operation.-operationDirname :: Spec-operationDirname = do-  it-    "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"-    (dirname ($(mkAbsDir "/home/chris/") </> $(mkRelDir "bar")) ==-     dirname $(mkRelDir "bar"))-  it-    "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"-    (dirname ($(mkRelDir "home/chris/") </> $(mkRelDir "bar")) ==-     dirname $(mkRelDir "bar"))-  it-    "dirname / must be a Rel path"-    ((parseAbsDir $ show $ dirname (fromJust (parseAbsDir "/"))-     :: Maybe (Path Abs Dir)) == Nothing)---- | The 'filename' operation.-operationFilename :: Spec-operationFilename =-  do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"-          (filename ($(mkAbsDir "/home/chris/") </>-                             $(mkRelFile "bar.txt")) ==-                                      filename $(mkRelFile "bar.txt"))--     it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"-             (filename ($(mkRelDir "home/chris/") </>-                                $(mkRelFile "bar.txt")) ==-                                         filename $(mkRelFile "bar.txt"))---- | The 'parent' operation.-operationParent :: Spec-operationParent =-  do it "parent (parent </> child) == parent"-        (parent ($(mkAbsDir "/foo") </>-                    $(mkRelDir "bar")) ==-         $(mkAbsDir "/foo"))-     it "parent \"/\" == \"/\""-        (parent $(mkAbsDir "/") == $(mkAbsDir "/"))-     it "parent \"/x\" == \"/\""-        (parent $(mkAbsDir "/x") == $(mkAbsDir "/"))-     it "parent \"x\" == \".\""-        (parent $(mkRelDir "x") == $(mkRelDir "."))-     it "parent \".\" == \".\""-        (parent $(mkRelDir ".") == $(mkRelDir "."))---- | The 'splitDrive' operation.-operationSplitDrive :: Spec-operationSplitDrive =-  do it "splitDrive \"/dir\" == (\"/\", Just \"dir\")"-        (splitDrive $(mkAbsDir "/dir") == ($(mkAbsDir "/"), Just $(mkRelDir "dir")))-     it "splitDrive \"/file\" == (\"/\", Just \"file\")"-        (splitDrive $(mkAbsFile "/file") == ($(mkAbsDir "/"), Just $(mkRelFile "file")))-     it "splitDrive \"/\" == (\"/\", Nothing)"-        (splitDrive $(mkAbsDir "/") == ($(mkAbsDir "/"), Nothing))---- | The 'isDrive' operation.-operationIsDrive :: Spec-operationIsDrive =-  do it "isDrive \"/\" == True"-        (isDrive $(mkAbsDir "/") == True)-     it "isDrive \"/dir\" == False"-        (isDrive $(mkAbsDir "/dir") == False)---- | The 'isProperPrefixOf' operation.-operationIsProperPrefixOf :: Spec-operationIsProperPrefixOf =-  do it "isProperPrefixOf parent (parent </> child) (absolute)"-        (isProperPrefixOf-           $(mkAbsDir "///bar/")-           ($(mkAbsDir "///bar/") </>-            $(mkRelFile "bar/foo.txt")))--     it "isProperPrefixOf parent (parent </> child) (relative)"-        (isProperPrefixOf-           $(mkRelDir "bar/")-           ($(mkRelDir "bar/") </>-            $(mkRelFile "bob/foo.txt")))--     it "not (x `isProperPrefixOf` x)"-        (not (isProperPrefixOf $(mkRelDir "x") $(mkRelDir "x")))--     it "not (/ `isProperPrefixOf` /)"-        (not (isProperPrefixOf $(mkAbsDir "/") $(mkAbsDir "/")))---- | The 'stripProperPrefix' operation.-operationStripProperPrefix :: Spec-operationStripProperPrefix =-  do it "stripProperPrefix parent (parent </> child) = child (unit test)"-        (stripProperPrefix $(mkAbsDir "///bar/")-                  ($(mkAbsDir "///bar/") </>-                   $(mkRelFile "bar/foo.txt")) ==-         Just $(mkRelFile "bar/foo.txt"))--     it "stripProperPrefix parent (parent </> child) = child (unit test)"-        (stripProperPrefix $(mkRelDir "bar/")-                  ($(mkRelDir "bar/") </>-                   $(mkRelFile "bob/foo.txt")) ==-         Just $(mkRelFile "bob/foo.txt"))--     it "stripProperPrefix parent parent = _|_"-        (stripProperPrefix $(mkAbsDir "/home/chris/foo")-                  $(mkAbsDir "/home/chris/foo") ==-         Nothing)---- | The '</>' operation.-operationAppend :: Spec-operationAppend =-  do it "AbsDir + RelDir = AbsDir"-        ($(mkAbsDir "/home/") </>-         $(mkRelDir "chris") ==-         $(mkAbsDir "/home/chris/"))-     it "AbsDir + RelFile = AbsFile"-        ($(mkAbsDir "/home/") </>-         $(mkRelFile "chris/test.txt") ==-         $(mkAbsFile "/home/chris/test.txt"))-     it "RelDir + RelDir = RelDir"-        ($(mkRelDir "home/") </>-         $(mkRelDir "chris") ==-         $(mkRelDir "home/chris"))-     it ". + . = ."-        ($(mkRelDir "./") </> $(mkRelDir ".") == $(mkRelDir "."))-     it ". + x = x"-        ($(mkRelDir ".") </> $(mkRelDir "x") == $(mkRelDir "x"))-     it "x + . = x"-        ($(mkRelDir "x") </> $(mkRelDir "./") == $(mkRelDir "x"))-     it "RelDir + RelFile = RelFile"-        ($(mkRelDir "home/") </>-         $(mkRelFile "chris/test.txt") ==-         $(mkRelFile "home/chris/test.txt"))--operationToFilePath :: Spec-operationToFilePath =-  do it "toFilePath $(mkRelDir \".\") == \"./\""-        (toFilePath $(mkRelDir ".") == "./")-     it "show $(mkRelDir \".\") == \"\\\"./\\\"\""-        (show $(mkRelDir ".") == "\"./\"")- -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =@@ -291,22 +136,6 @@    where failing x = parserTest parseRelFile x Nothing         succeeding x with = parserTest parseRelFile x (Just with)---- | Parser test.-parserTest :: (Show a1,Show a,Eq a1)-           => (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()-parserTest parser input expected =-  it ((case expected of-         Nothing -> "Failing: "-         Just{} -> "Succeeding: ") ++-      "Parsing " ++-      show input ++-      " " ++-      case expected of-        Nothing -> "should fail."-        Just x -> "should succeed with: " ++ show x)-     (actual `shouldBe` expected)-  where actual = parser input  -- | Tests for the 'ToJSON' and 'FromJSON' instances --
+ test/TH/Posix.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Posix+#include "Include.hs"++qqAbsDir :: FilePath+qqAbsDir = checkInstantiated [absdir|/name/|]++qqAbsFile :: FilePath+qqAbsFile = checkInstantiated [absdir|/name|]++thAbsDir :: FilePath+thAbsDir = checkInstantiated $(mkAbsDir "/name/")++thAbsFile :: FilePath+thAbsFile = checkInstantiated $(mkAbsFile "/name")++liftAbsDir :: FilePath+liftAbsDir = checkInstantiated $(TH.lift (Path "/name/" :: Path Abs Dir))++liftAbsFile :: FilePath+liftAbsFile = checkInstantiated $(TH.lift (Path "/name" :: Path Abs File))
+ test/TH/Windows.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Windows+#include "Include.hs"++qqAbsDir :: FilePath+qqAbsDir = checkInstantiated [absdir|C:\foo\|]++qqAbsFile :: FilePath+qqAbsFile = checkInstantiated [absdir|C:\foo|]++thAbsDir :: FilePath+thAbsDir = checkInstantiated $(mkAbsDir "C:\\foo\\")++thAbsFile :: FilePath+thAbsFile = checkInstantiated $(mkAbsFile "C:\\foo")++liftAbsDir :: FilePath+liftAbsDir = checkInstantiated $(TH.lift (Path "C:\\foo\\" :: Path Abs Dir))++liftAbsFile :: FilePath+liftAbsFile = checkInstantiated $(TH.lift (Path "C:\\foo" :: Path Abs File))
− test/ValidityTest.hs 
@@ -1,267 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}---- | Test suite.-module Main where--import Data.Maybe-import Path-import Path.Internal-import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck-import Test.Validity--import Path.Gen---- | Test suite entry point, returns exit failure if any test fails.-main :: IO ()-main = hspec spec---- | Test suite.-spec :: Spec-spec =-  modifyMaxShrinks (const 100) $-  parallel $ do-    genValidSpec @(Path Abs File)-    shrinkValidSpec @(Path Abs File)-    genValidSpec @(Path Rel File)-    shrinkValidSpec @(Path Rel File)-    genValidSpec @(Path Abs Dir)-    shrinkValidSpec @(Path Abs Dir)-    genValidSpec @(Path Rel Dir)-    shrinkValidSpec @(Path Rel Dir)-    genValidSpec @(SomeBase Dir)-    shrinkValidSpec @(SomeBase Dir)-    genValidSpec @(SomeBase File)-    shrinkValidSpec @(SomeBase File)-    describe "Parsing" $ do-      describe "Path Abs Dir" (parserSpec parseAbsDir)-      describe "Path Rel Dir" (parserSpec parseRelDir)-      describe "Path Abs File" (parserSpec parseAbsFile)-      describe "Path Rel File" (parserSpec parseRelFile)-      describe "SomeBase Dir" (parserSpec parseSomeDir)-      describe "SomeBase file" (parserSpec parseSomeFile)-    describe "Operations" $ do-      describe "(</>)" operationAppend-      describe "stripProperPrefix" operationStripDir-      describe "isProperPrefixOf" operationIsParentOf-      describe "parent" operationParent-      describe "splitDrive" operationSplitDrive-      describe "takeDrive" operationTakeDrive-      describe "filename" operationFilename-      describe "dirname" operationDirname-    describe "Extensions" extensionsSpec---- | The 'filename' operation.-operationFilename :: Spec-operationFilename = do-  forAllDirs "filename (parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \parent ->-    forAllValid $ \file -> filename (parent </> file) `shouldBe` filename file-  forSomeDirs "filename (some:parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \someParent ->-    forAllValid $ \file ->-    prjSomeBase filename (mapSomeBase (</> file) someParent) `shouldBe` filename file-  it "produces a valid path on when passed a valid absolute path" $ do-    producesValid (filename :: Path Abs File -> Path Rel File)-  it "produces a valid path on when passed a valid relative path" $ do-    producesValid (filename :: Path Rel File -> Path Rel File)-  it "produces a valid filename when passed some valid base path" $-    producesValid (prjSomeBase filename :: SomeBase File -> Path Rel File)---- | The 'dirname' operation.-operationDirname :: Spec-operationDirname = do-  forAllDirs "dirname parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \parent ->-    forAllValid $ \dir -> if dir == Path [] then pure () else dirname (parent </> dir) `shouldBe` dirname dir-  forSomeDirs "dirname (some:parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \someParent ->-    forAllValid $ \dir -> if dir == Path []-                          then pure ()-                          else prjSomeBase dirname (mapSomeBase (</> dir) someParent) `shouldBe` dirname dir-  it "produces a valid path on when passed a valid absolute path" $ do-    producesValid (dirname :: Path Abs Dir -> Path Rel Dir)-  it "produces a valid path on when passed a valid relative path" $ do-    producesValid (dirname :: Path Rel Dir -> Path Rel Dir)-  it "produces a valid path when passed some valid longer path" $-    producesValid (prjSomeBase dirname :: SomeBase Dir -> Path Rel Dir)---- | The 'parent' operation.-operationParent :: Spec-operationParent = do-  it "produces a valid path on when passed a valid file path" $ do-    producesValid (parent :: Path Abs File -> Path Abs Dir)-  it "produces a valid path on when passed a valid directory path" $ do-    producesValid (parent :: Path Abs Dir -> Path Abs Dir)-  it "produces a valid path on when passed a valid abs file path" $ do-    producesValid (parent :: Path Abs File -> Path Abs Dir)-  it "produces a valid path on when passed a valid rel file path" $ do-    producesValid (parent :: Path Rel File -> Path Rel Dir)-  it "produces a valid path on when passed a valid abs directory path" $ do-    producesValid (parent :: Path Abs Dir -> Path Abs Dir)-  it "produces a valid path on when passed a valid rel directory path" $ do-    producesValid (parent :: Path Rel Dir -> Path Rel Dir)---- | The 'splitDrive' operation.-operationSplitDrive :: Spec-operationSplitDrive = do-  it "produces valid paths on when passed a valid directory path" $ do-    producesValid (splitDrive :: Path Abs Dir -> (Path Abs Dir, Maybe (Path Rel Dir)))-  it "produces valid paths on when passed a valid file path" $ do-    producesValid (splitDrive :: Path Abs File -> (Path Abs Dir, Maybe (Path Rel File)))---- | The 'takeDrive' operation.-operationTakeDrive :: Spec-operationTakeDrive = do-  it "produces a valid path on when passed a valid directory path" $ do-    producesValid (takeDrive :: Path Abs Dir -> Path Abs Dir)-  it "produces a valid path on when passed a valid file path" $ do-    producesValid (takeDrive :: Path Abs File -> Path Abs Dir)---- | The 'isProperPrefixOf' operation.-operationIsParentOf :: Spec-operationIsParentOf = do-  forAllParentsAndChildren "isProperPrefixOf parent (parent </> child)" $ \parent child ->-    if child == Path []-      then True -- TODO do we always need this condition?-      else isProperPrefixOf parent (parent </> child)---- | The 'stripProperPrefix' operation.-operationStripDir :: Spec-operationStripDir = do-  forAllParentsAndChildren "stripProperPrefix parent (parent </> child) = child" $ \parent child ->-    if child == Path []-      then pure () -- TODO do we always need this condition?-      else stripProperPrefix parent (parent </> child) `shouldBe` Just child-  it "produces a valid path on when passed a valid absolute file paths" $ do-    producesValid2-      (stripProperPrefix :: Path Abs Dir -> Path Abs File -> Maybe (Path Rel File))-  it "produces a valid path on when passed a valid absolute directory paths" $ do-    producesValid2-      (stripProperPrefix :: Path Abs Dir -> Path Abs Dir -> Maybe (Path Rel Dir))-  it "produces a valid path on when passed a valid relative file paths" $ do-    producesValid2-      (stripProperPrefix :: Path Rel Dir -> Path Rel File -> Maybe (Path Rel File))-  it "produces a valid path on when passed a valid relative directory paths" $ do-    producesValid2-      (stripProperPrefix :: Path Rel Dir -> Path Rel Dir -> Maybe (Path Rel Dir))---- | The '</>' operation.-operationAppend :: Spec-operationAppend = do-  it "produces a valid path on when creating valid absolute file paths" $ do-    producesValid2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)-  it "produces a valid path on when creating valid absolute directory paths" $ do-    producesValid2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)-  it "produces a valid path on when creating valid relative file paths" $ do-    producesValid2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File)-  it "produces a valid path on when creating valid relative directory paths" $ do-    producesValid2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)--extensionsSpec :: Spec-extensionsSpec = do-  let addExtGensValidFile p =-        case addExtension p $(mkRelFile "x") of-          Nothing -> True-          Just _ ->-            case parseRelFile p of-              Nothing -> False-              _ -> True-  it "if addExtension a b succeeds then parseRelFile b succeeds - 1" $-    forAll genFilePath addExtGensValidFile-  -- skew the generated path towards a valid extension by prefixing a "."-  it "if addExtension a b succeeds then parseRelFile b succeeds - 2" $-    forAll genFilePath $ addExtGensValidFile . ("." ++)-  forAllFiles "Adding an extension is like adding the extension to the end if it succeeds" $ \file ->-    forAllValid $ \ext ->-      case addExtension ext file of-        Nothing -> pure () -- Fine-        Just p -> toFilePath p `shouldBe` toFilePath file ++ ext-  forAllFiles "splitExtension output joins to result in the original file" $ \file ->-    case splitExtension file of-      Nothing -> pure ()-      Just (f, ext) -> toFilePath f ++ ext `shouldBe` toFilePath file-  forAllFiles "splitExtension generates a valid filename and valid extension" $ \file ->-    case splitExtension file of-      Nothing -> True-      Just (f, ext) ->-        case parseRelFile ext of-          Nothing -> False-          Just _ ->-            case parseRelFile (toFilePath f) of-              Nothing ->-                case parseAbsFile (toFilePath f) of-                  Nothing -> False-                  Just _ -> True-              Just _ -> True-  forAllFiles "splitExtension >=> uncurry addExtension . swap == return" $ \file ->-    case splitExtension file of-      Nothing -> pure ()-      Just (f, ext) -> addExtension ext f `shouldBe` Just file-  forAllFiles "an extension that was added can be split off again" $ \file ->-    forAllValid $ \ext ->-      case addExtension ext file of-        Nothing -> pure () -- Fine-        Just p -> splitExtension p `shouldBe` Just (file, ext)-  forAllFiles "fileExtension == (fmap snd) . splitExtension" $ \file ->-    case splitExtension file of-      Nothing -> pure ()-      Just (_, ext) -> fileExtension file `shouldBe` Just ext-  forAllFiles "an extension that was added is considered to be there" $ \file ->-    forAllValid $ \ext ->-      case addExtension ext file of-        Nothing -> pure () -- Fine-        Just p -> fileExtension p `shouldBe` Just ext-  forAllFiles "(fileExtension >=> flip replaceExtension file) file == return file" $ \file ->-    case fileExtension file of-      Nothing -> pure ()-      Just ext -> replaceExtension ext file `shouldBe` Just file--forAllFiles :: Testable a => String -> (forall b. Path b File -> a) -> Spec-forAllFiles n func = do-  it (unwords [n, "Path Abs File"]) $ forAllValid $ \(file :: Path Abs File) -> func file-  it (unwords [n, "Path Rel File"]) $ forAllValid $ \(file :: Path Rel File) -> func file--forAllDirs :: Testable a => String -> (forall b. Path b Dir -> a) -> Spec-forAllDirs n func = do-  it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(parent :: Path Abs Dir) -> func parent-  it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(parent :: Path Rel Dir) -> func parent--forSomeDirs :: Testable a => String -> (SomeBase Dir -> a) -> Spec-forSomeDirs n func = do-  it (unwords [n, "SomeBase Dir"]) $ forAllValid $ \(parent :: SomeBase Dir) -> func parent--forAllParentsAndChildren ::-     Testable a => String -> (forall b t. Path b Dir -> Path Rel t -> a) -> Spec-forAllParentsAndChildren n func = do-  it (unwords [n, "Path Abs Dir", "Path Rel Dir"]) $-    forAllValid $ \(parent :: Path Abs Dir) ->-      forAllValid $ \(child :: Path Rel Dir) -> func parent child-  it (unwords [n, "Path Rel Dir", "Path Rel Dir"]) $-    forAllValid $ \(parent :: Path Rel Dir) ->-      forAllValid $ \(child :: Path Rel Dir) -> func parent child-  it (unwords [n, "Path Abs Dir", "Path Rel File"]) $-    forAllValid $ \(parent :: Path Abs Dir) ->-      forAllValid $ \(child :: Path Rel File) -> func parent child-  it (unwords [n, "Path Rel Dir", "Path Rel File"]) $-    forAllValid $ \(parent :: Path Rel Dir) ->-      forAllValid $ \(child :: Path Rel File) -> func parent child--forAllPaths :: Testable a => String -> (forall b t. Path b t -> a) -> Spec-forAllPaths n func = do-  it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(path :: Path Abs Dir) -> func path-  it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(path :: Path Rel Dir) -> func path-  it (unwords [n, "Path Abs File"]) $ forAllValid $ \(path :: Path Abs File) -> func path-  it (unwords [n, "Path Rel File"]) $ forAllValid $ \(path :: Path Rel File) -> func path--parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec-parserSpec parser =-  it "Produces valid paths when it succeeds" $-  forAllShrink genFilePath shrinkValid $ \path ->-    case parser path of-      Nothing -> pure ()-      Just p ->-        case prettyValidate p of-          Left err -> expectationFailure err-          Right _ -> pure ()
test/Windows.hs view
@@ -7,16 +7,15 @@  module Windows (spec) where -import Control.Applicative-import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Maybe-import Path.Windows-import Path.Internal.Windows import Test.Hspec -import Common.Windows (extensionOperations)+import Common.Windows (parseFails, parseSucceeds, parserTest)+import qualified Common.Windows+import Path.Windows+import Path.Internal.Windows+import TH.Windows ()  -- | Test suite (Windows version). spec :: Spec@@ -25,16 +24,7 @@      describe "Parsing: Path Rel Dir" parseRelDirSpec      describe "Parsing: Path Abs File" parseAbsFileSpec      describe "Parsing: Path Rel File" parseRelFileSpec-     describe "Operations: (</>)" operationAppend-     describe "Operations: toFilePath" operationToFilePath-     describe "Operations: stripProperPrefix" operationStripProperPrefix-     describe "Operations: isProperPrefixOf" operationIsProperPrefixOf-     describe "Operations: parent" operationParent-     describe "Operations: splitDrive" operationSplitDrive-     describe "Operations: isDrive" operationIsDrive-     describe "Operations: filename" operationFilename-     describe "Operations: dirname" operationDirname-     describe "Operations: extensions" (extensionOperations "C:\\")+     Common.Windows.spec      describe "Restrictions" restrictions      describe "Aeson Instances" aesonInstances      describe "QuasiQuotes" quasiquotes@@ -49,215 +39,7 @@      parseFails "\\.."      parseFails "C:\\foo\\..\\bar\\"      parseFails "C:\\foo\\bar\\.."-  where parseFails x =-          it (show x ++ " should be rejected")-             (isNothing (void (parseAbsDir x) <|>-                         void (parseRelDir x) <|>-                         void (parseAbsFile x) <|>-                         void (parseRelFile x)))-        parseSucceeds x with =-          parserTest parseRelDir x (Just with) --- | The 'dirname' operation.-operationDirname :: Spec-operationDirname =-  do it "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (absolute)"-        (dirnamesShouldBeEqual-          ($(mkAbsDir "C:\\chris\\") </> $(mkRelDir "bar"))-          $(mkRelDir "bar"))-     it "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (relative)"-        (dirnamesShouldBeEqual-          ($(mkRelDir "home\\chris\\") </> $(mkRelDir "bar"))-          $(mkRelDir "bar"))-     it "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (UNC)"-        (dirnamesShouldBeEqual-          ($(mkAbsDir "\\\\home\\chris\\") </> $(mkRelDir "bar"))-          $(mkRelDir "bar"))-     it "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (Unicode)"-        (dirnamesShouldBeEqual-          ($(mkAbsDir "\\\\?\\C:\\home\\chris\\") </> $(mkRelDir "bar"))-          $(mkRelDir "bar"))-     it "dirname $(mkRelDir .) == $(mkRelDir .)"-        (dirnamesShouldBeEqual-          $(mkRelDir ".")-          $(mkRelDir "."))-     it "dirname C:\\ must be a Rel path"-        ((parseAbsDir $ show $ dirname (fromJust (parseAbsDir "C:\\")) :: Maybe (Path Abs Dir)) == Nothing)-  where dirnamesShouldBeEqual x y = dirname x == dirname y---- | The 'filename' operation.-operationFilename :: Spec-operationFilename =-  do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (absolute)"-        (filenamesShouldBeEqual-          ($(mkAbsDir "C:\\chris\\") </> $(mkRelFile "bar.txt"))-          $(mkRelFile "bar.txt"))-     it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (relative)"-        (filenamesShouldBeEqual-          ($(mkRelDir "home\\chris\\") </> $(mkRelFile "bar.txt"))-          $(mkRelFile "bar.txt"))-     it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (UNC)"-        (filenamesShouldBeEqual-          ($(mkAbsDir "\\\\host\\share\\chris\\") </> $(mkRelFile "bar.txt"))-          $(mkRelFile "bar.txt"))-     it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (Unicode)"-        (filenamesShouldBeEqual-          ($(mkAbsDir "\\\\?\\C:\\home\\chris\\") </> $(mkRelFile "bar.txt"))-          $(mkRelFile "bar.txt"))-  where filenamesShouldBeEqual x y = filename x == filename y---- | The 'parent' operation.-operationParent :: Spec-operationParent =-  do it "parent (parent </> child) == parent"-        (parent ($(mkAbsDir "C:\\foo") </> $(mkRelDir "bar")) == $(mkAbsDir "C:\\foo"))-     it "parent \"C:\\\" == \"C:\\\""-        (parent $(mkAbsDir "C:\\") == $(mkAbsDir "C:\\"))-     it "parent \"C:\\x\" == \"C:\\\""-        (parent $(mkAbsDir "C:\\x") == $(mkAbsDir "C:\\"))-     it "parent \"x\" == \".\""-        (parent $(mkRelDir "x") == $(mkRelDir "."))-     it "parent \".\" == \".\""-        (parent $(mkRelDir ".") == $(mkRelDir "."))---- | The 'splitDrive' operation.-operationSplitDrive :: Spec-operationSplitDrive =-  do it "splitDrive \"C:/dir\" == (\"C:/\", Just \"dir\")"-        (splitDrive $(mkAbsDir "C:/dir") == ($(mkAbsDir "C:/"), Just $(mkRelDir "dir")))-     it "splitDrive \"C:\\dir\" == (\"C:\\\", Just \"dir\")"-        (splitDrive $(mkAbsDir "C:\\dir") == ($(mkAbsDir "C:\\"), Just $(mkRelDir "dir")))-     it "splitDrive \"C:/file\" == (\"C:/\", Just \"file\")"-        (splitDrive $(mkAbsFile "C:/file") == ($(mkAbsDir "C:/"), Just $(mkRelFile "file")))-     it "splitDrive \"C:\\file\" == (\"C:\\\", Just \"file\")"-        (splitDrive $(mkAbsFile "C:\\file") == ($(mkAbsDir "C:\\"), Just $(mkRelFile "file")))-     it "splitDrive \"C:/\" == (\"C:/\", Nothing)"-        (splitDrive $(mkAbsDir "C:/") == ($(mkAbsDir "C:/"), Nothing))-     it "splitDrive \"C:\\\" == (\"C:\\\", Nothing)"-        (splitDrive $(mkAbsDir "C:\\") == ($(mkAbsDir "C:\\"), Nothing))---- | The 'isDrive' operation.-operationIsDrive :: Spec-operationIsDrive =-  do it "isDrive \"C:/\" == True"-        (isDrive $(mkAbsDir "C:/") == True)-     it "isDrive \"C:\\\" == True"-        (isDrive $(mkAbsDir "C:\\") == True)-     it "isDrive \"C:/dir\" == False"-        (isDrive $(mkAbsDir "C:/dir") == False)-     it "isDrive \"C:\\dir\" == False"-        (isDrive $(mkAbsDir "C:\\dir") == False)---- | The 'isProperPrefixOf' operation.-operationIsProperPrefixOf :: Spec-operationIsProperPrefixOf =-  do it "isProperPrefixOf parent (parent </> child) (absolute)"-        (isProperPrefixOf-          $(mkAbsDir "C:\\\\\\bar\\")-          ($(mkAbsDir "C:\\\\\\bar\\") </> $(mkRelFile "bar\\foo.txt")))-     it "isProperPrefixOf parent (parent </> child) (relative)"-        (isProperPrefixOf-          $(mkRelDir "bar\\")-          ($(mkRelDir "bar\\") </> $(mkRelFile "bob\\foo.txt")))-     it "isProperPrefixOf parent (parent </> child) (UNC)"-        (isProperPrefixOf-          $(mkAbsDir "\\\\host\\share\\")-          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelFile "bob\\foo.txt")))-     it "isProperPrefixOf parent (parent </> child) (Unicode)"-        (isProperPrefixOf-          $(mkAbsDir "\\\\?\\C:\\folder\\")-          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelFile "bob\\foo.txt")))-     it "not (x `isProperPrefixOf` x)"-        (not (isProperPrefixOf $(mkRelDir "x") $(mkRelDir "x")))-     it "not (\\ `isProperPrefixOf` \\)"-        (not (isProperPrefixOf $(mkAbsDir "C:\\") $(mkAbsDir "C:\\")))---- | The 'stripProperPrefix' operation.-operationStripProperPrefix :: Spec-operationStripProperPrefix =-  do it "stripProperPrefix parent (parent </> child) = child (absolute)"-        (remainingPathShouldBe-          $(mkAbsDir "C:\\\\\\bar\\")-          ($(mkAbsDir "C:\\\\\\bar\\") </> $(mkRelFile "bar\\foo.txt"))-          (Just $(mkRelFile "bar\\foo.txt")))-     it "stripProperPrefix parent (parent </> child) = child (relative)"-        (remainingPathShouldBe-          $(mkRelDir "bar\\")-          ($(mkRelDir "bar\\") </> $(mkRelFile "bob\\foo.txt"))-          (Just $(mkRelFile "bob\\foo.txt")))-     it "stripProperPrefix parent (parent </> child) = child (UNC)"-        (remainingPathShouldBe-          $(mkAbsDir "\\\\host\\share\\")-          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelFile "bob\\foo.txt"))-          (Just $(mkRelFile "bob\\foo.txt")))-     it "stripProperPrefix parent (parent </> child) = child (Unicode)"-        (remainingPathShouldBe-          $(mkAbsDir "\\\\?\\C:\\folder\\")-          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelFile "bob\\foo.txt"))-          (Just $(mkRelFile "bob\\foo.txt")))-     it "stripProperPrefix parent parent = _|_"-        (remainingPathShouldBe-          $(mkAbsDir "C:\\home\\chris\\foo")-          $(mkAbsDir "C:\\home\\chris\\foo")-          Nothing)-  where remainingPathShouldBe prefix path suffix =-          stripProperPrefix prefix path == suffix---- | The '</>' operation.-operationAppend :: Spec-operationAppend =-  do it "AbsDir + RelDir = AbsDir"-        (shouldBe-          ($(mkAbsDir "C:\\home\\") </> $(mkRelDir "chris"))-          $(mkAbsDir "C:\\home\\chris\\"))-     it "AbsDir + RelFile = AbsFile"-        (shouldBe-          ($(mkAbsDir "C:\\home\\") </> $(mkRelFile "chris\\test.txt"))-          $(mkAbsFile "C:\\home\\chris\\test.txt"))-     it "RelDir + RelDir = RelDir"-        (shouldBe-          ($(mkRelDir "home\\") </> $(mkRelDir "chris"))-          $(mkRelDir "home\\chris"))-     it ". + . = ."-        (shouldBe-          ($(mkRelDir ".\\") </> $(mkRelDir "."))-          $(mkRelDir "."))-     it ". + x = x"-        (shouldBe-          ($(mkRelDir ".") </> $(mkRelDir "x"))-          $(mkRelDir "x"))-     it "x + . = x"-        (shouldBe-          ($(mkRelDir "x") </> $(mkRelDir ".\\"))-          $(mkRelDir "x"))-     it "RelDir + RelFile = RelFile"-        (shouldBe-          ($(mkRelDir "home\\") </> $(mkRelFile "chris\\test.txt"))-          $(mkRelFile "home\\chris\\test.txt"))-     it "AbsDir(UNC) + RelDir = AbsDir(UNC)"-        (shouldBe-          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelDir "folder\\"))-          $(mkAbsDir "\\\\host\\share\\folder\\"))-     it "AbsDir(UNC) + RelFile = AbsFile(UNC)"-        (shouldBe-          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelFile "folder\\file.txt"))-          $(mkAbsFile "\\\\host\\share\\folder\\file.txt"))-     it "AbsDir(Unicode) + RelDir = AbsDir(Unicode)"-        (shouldBe-          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelDir "another\\"))-          $(mkAbsDir "\\\\?\\C:\\folder\\another\\"))-     it "AbsDir(Unicode) + RelFile = AbsFile(Unicode)"-        (shouldBe-          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelFile "file.txt"))-          $(mkAbsFile "\\\\?\\C:\\folder\\file.txt"))--operationToFilePath :: Spec-operationToFilePath =-  do it "toFilePath $(mkRelDir \".\") == \"./\""-        (toFilePath $(mkRelDir ".") == ".\\")-     it "show $(mkRelDir \".\") == \"\\\".\\\\\"\""-        (show $(mkRelDir ".") == "\".\\\\\"")- -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =@@ -364,22 +146,6 @@    where failing x = parserTest parseRelFile x Nothing         succeeding x with = parserTest parseRelFile x (Just with)---- | Parser test.-parserTest :: (Show a1,Show a,Eq a1)-           => (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()-parserTest parser input expected =-  it ((case expected of-         Nothing -> "Failing: "-         Just{} -> "Succeeding: ") ++-      "Parsing " ++-      show input ++-      " " ++-      case expected of-        Nothing -> "should fail."-        Just x -> "should succeed with: " ++ show x)-     (actual `shouldBe` expected)-  where actual = parser input  -- | Tests for the 'ToJSON' and 'FromJSON' instances --
+ validity-test-ospath/Include.hs view
@@ -0,0 +1,268 @@+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++{-# OPTIONS_GHC -Wno-name-shadowing #-}++-- | Test suite.+module PLATFORM_NAME where++import OsPath.PLATFORM_NAME+import OsPath.Internal.PLATFORM_NAME+import System.OsPath.PLATFORM_NAME (PLATFORM_PATH)+import Test.Hspec+import Test.QuickCheck+import Test.Validity++import OsPath.Gen.PLATFORM_NAME ()+import qualified System.OsString.Compat.PLATFORM_NAME as OsString++-- | Test suite entry point, returns exit failure if any test fails.+main :: IO ()+main = hspec spec++-- | Test suite.+spec :: Spec+spec =+  describe PLATFORM_NAME_STRING $ do+    genValidSpec @(Path Abs File)+    shrinkValidSpec @(Path Abs File)+    genValidSpec @(Path Rel File)+    shrinkValidSpec @(Path Rel File)+    genValidSpec @(Path Abs Dir)+    shrinkValidSpec @(Path Abs Dir)+    genValidSpec @(Path Rel Dir)+    shrinkValidSpec @(Path Rel Dir)+    genValidSpec @(SomeBase Dir)+    shrinkValidSpec @(SomeBase Dir)+    genValidSpec @(SomeBase File)+    shrinkValidSpec @(SomeBase File)+    describe "Parsing" $ do+      describe "Path Abs Dir" (parserSpec parseAbsDir)+      describe "Path Rel Dir" (parserSpec parseRelDir)+      describe "Path Abs File" (parserSpec parseAbsFile)+      describe "Path Rel File" (parserSpec parseRelFile)+      describe "SomeBase Dir" (parserSpec parseSomeDir)+      describe "SomeBase file" (parserSpec parseSomeFile)+    describe "Operations" $ do+      describe "(</>)" operationAppend+      describe "stripProperPrefix" operationStripDir+      describe "isProperPrefixOf" operationIsParentOf+      describe "parent" operationParent+      describe "splitDrive" operationSplitDrive+      describe "takeDrive" operationTakeDrive+      describe "filename" operationFilename+      describe "dirname" operationDirname+    describe "Extensions" extensionsSpec++-- | The 'filename' operation.+operationFilename :: Spec+operationFilename = do+  forAllDirs "filename (parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \parent ->+    forAllValid $ \file -> filename (parent </> file) `shouldBe` filename file+  forSomeDirs "filename (some:parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \someParent ->+    forAllValid $ \file ->+    prjSomeBase filename (mapSomeBase (</> file) someParent) `shouldBe` filename file+  it "produces a valid path on when passed a valid absolute path" $ do+    producesValid (filename :: Path Abs File -> Path Rel File)+  it "produces a valid path on when passed a valid relative path" $ do+    producesValid (filename :: Path Rel File -> Path Rel File)+  it "produces a valid filename when passed some valid base path" $+    producesValid (prjSomeBase filename :: SomeBase File -> Path Rel File)++-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+  forAllDirs "dirname parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \parent ->+    forAllValid $ \dir -> if dir == Path OsString.empty then pure () else dirname (parent </> dir) `shouldBe` dirname dir+  forSomeDirs "dirname (some:parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \someParent ->+    forAllValid $ \dir -> if dir == Path OsString.empty+                          then pure ()+                          else prjSomeBase dirname (mapSomeBase (</> dir) someParent) `shouldBe` dirname dir+  it "produces a valid path on when passed a valid absolute path" $ do+    producesValid (dirname :: Path Abs Dir -> Path Rel Dir)+  it "produces a valid path on when passed a valid relative path" $ do+    producesValid (dirname :: Path Rel Dir -> Path Rel Dir)+  it "produces a valid path when passed some valid longer path" $+    producesValid (prjSomeBase dirname :: SomeBase Dir -> Path Rel Dir)++-- | The 'parent' operation.+operationParent :: Spec+operationParent = do+  it "produces a valid path on when passed a valid file path" $ do+    producesValid (parent :: Path Abs File -> Path Abs Dir)+  it "produces a valid path on when passed a valid directory path" $ do+    producesValid (parent :: Path Abs Dir -> Path Abs Dir)+  it "produces a valid path on when passed a valid abs file path" $ do+    producesValid (parent :: Path Abs File -> Path Abs Dir)+  it "produces a valid path on when passed a valid rel file path" $ do+    producesValid (parent :: Path Rel File -> Path Rel Dir)+  it "produces a valid path on when passed a valid abs directory path" $ do+    producesValid (parent :: Path Abs Dir -> Path Abs Dir)+  it "produces a valid path on when passed a valid rel directory path" $ do+    producesValid (parent :: Path Rel Dir -> Path Rel Dir)++-- | The 'splitDrive' operation.+operationSplitDrive :: Spec+operationSplitDrive = do+  it "produces valid paths on when passed a valid directory path" $ do+    producesValid (splitDrive :: Path Abs Dir -> (Path Abs Dir, Maybe (Path Rel Dir)))+  it "produces valid paths on when passed a valid file path" $ do+    producesValid (splitDrive :: Path Abs File -> (Path Abs Dir, Maybe (Path Rel File)))++-- | The 'takeDrive' operation.+operationTakeDrive :: Spec+operationTakeDrive = do+  it "produces a valid path on when passed a valid directory path" $ do+    producesValid (takeDrive :: Path Abs Dir -> Path Abs Dir)+  it "produces a valid path on when passed a valid file path" $ do+    producesValid (takeDrive :: Path Abs File -> Path Abs Dir)++-- | The 'isProperPrefixOf' operation.+operationIsParentOf :: Spec+operationIsParentOf = do+  forAllParentsAndChildren "isProperPrefixOf parent (parent </> child)" $ \parent child ->+    if child == Path OsString.empty+      then True -- TODO do we always need this condition?+      else isProperPrefixOf parent (parent </> child)++-- | The 'stripProperPrefix' operation.+operationStripDir :: Spec+operationStripDir = do+  forAllParentsAndChildren "stripProperPrefix parent (parent </> child) = child" $ \parent child ->+    if child == Path OsString.empty+      then pure () -- TODO do we always need this condition?+      else stripProperPrefix parent (parent </> child) `shouldBe` Just child+  it "produces a valid path on when passed a valid absolute file paths" $ do+    producesValid2+      (stripProperPrefix :: Path Abs Dir -> Path Abs File -> Maybe (Path Rel File))+  it "produces a valid path on when passed a valid absolute directory paths" $ do+    producesValid2+      (stripProperPrefix :: Path Abs Dir -> Path Abs Dir -> Maybe (Path Rel Dir))+  it "produces a valid path on when passed a valid relative file paths" $ do+    producesValid2+      (stripProperPrefix :: Path Rel Dir -> Path Rel File -> Maybe (Path Rel File))+  it "produces a valid path on when passed a valid relative directory paths" $ do+    producesValid2+      (stripProperPrefix :: Path Rel Dir -> Path Rel Dir -> Maybe (Path Rel Dir))++-- | The '</>' operation.+operationAppend :: Spec+operationAppend = do+  it "produces a valid path on when creating valid absolute file paths" $ do+    producesValid2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)+  it "produces a valid path on when creating valid absolute directory paths" $ do+    producesValid2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)+  it "produces a valid path on when creating valid relative file paths" $ do+    producesValid2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File)+  it "produces a valid path on when creating valid relative directory paths" $ do+    producesValid2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)++extensionsSpec :: Spec+extensionsSpec = do+  let addExtGensValidFile p =+        case addExtension p $(mkRelFile [OsString.pstr|x|]) of+          Nothing -> True+          Just _ ->+            case parseRelFile p of+              Nothing -> False+              _ -> True+  it "if addExtension a b succeeds then parseRelFile b succeeds - 1" $+    forAll genValid addExtGensValidFile+  -- skew the generated path towards a valid extension by prefixing a "."+  it "if addExtension a b succeeds then parseRelFile b succeeds - 2" $+    forAll genValid $ addExtGensValidFile . ([OsString.pstr|.|] <>)+  forAllFiles "Adding an extension is like adding the extension to the end if it succeeds" $ \file ->+    forAllValid $ \ext ->+      case addExtension ext file of+        Nothing -> pure () -- Fine+        Just p -> toOsPath p `shouldBe` toOsPath file <> ext+  forAllFiles "splitExtension output joins to result in the original file" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (f, ext) -> toOsPath f <> ext `shouldBe` toOsPath file+  forAllFiles "splitExtension generates a valid filename and valid extension" $ \file ->+    case splitExtension file of+      Nothing -> True+      Just (f, ext) ->+        case parseRelFile ext of+          Nothing -> False+          Just _ ->+            case parseRelFile (toOsPath f) of+              Nothing ->+                case parseAbsFile (toOsPath f) of+                  Nothing -> False+                  Just _ -> True+              Just _ -> True+  forAllFiles "splitExtension >=> uncurry addExtension . swap == return" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (f, ext) -> addExtension ext f `shouldBe` Just file+  forAllFiles "an extension that was added can be split off again" $ \file ->+    forAllValid $ \ext ->+      case addExtension ext file of+        Nothing -> pure () -- Fine+        Just p -> splitExtension p `shouldBe` Just (file, ext)+  forAllFiles "fileExtension == (fmap snd) . splitExtension" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (_, ext) -> fileExtension file `shouldBe` Just ext+  forAllFiles "an extension that was added is considered to be there" $ \file ->+    forAllValid $ \ext ->+      case addExtension ext file of+        Nothing -> pure () -- Fine+        Just p -> fileExtension p `shouldBe` Just ext+  forAllFiles "(fileExtension >=> flip replaceExtension file) file == return file" $ \file ->+    case fileExtension file of+      Nothing -> pure ()+      Just ext -> replaceExtension ext file `shouldBe` Just file++forAllFiles :: Testable a => String -> (forall b. Path b File -> a) -> Spec+forAllFiles n func = do+  it (unwords [n, "Path Abs File"]) $ forAllValid $ \(file :: Path Abs File) -> func file+  it (unwords [n, "Path Rel File"]) $ forAllValid $ \(file :: Path Rel File) -> func file++forAllDirs :: Testable a => String -> (forall b. Path b Dir -> a) -> Spec+forAllDirs n func = do+  it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(parent :: Path Abs Dir) -> func parent+  it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(parent :: Path Rel Dir) -> func parent++forSomeDirs :: Testable a => String -> (SomeBase Dir -> a) -> Spec+forSomeDirs n func = do+  it (unwords [n, "SomeBase Dir"]) $ forAllValid $ \(parent :: SomeBase Dir) -> func parent++forAllParentsAndChildren ::+     Testable a => String -> (forall b t. Path b Dir -> Path Rel t -> a) -> Spec+forAllParentsAndChildren n func = do+  it (unwords [n, "Path Abs Dir", "Path Rel Dir"]) $+    forAllValid $ \(parent :: Path Abs Dir) ->+      forAllValid $ \(child :: Path Rel Dir) -> func parent child+  it (unwords [n, "Path Rel Dir", "Path Rel Dir"]) $+    forAllValid $ \(parent :: Path Rel Dir) ->+      forAllValid $ \(child :: Path Rel Dir) -> func parent child+  it (unwords [n, "Path Abs Dir", "Path Rel File"]) $+    forAllValid $ \(parent :: Path Abs Dir) ->+      forAllValid $ \(child :: Path Rel File) -> func parent child+  it (unwords [n, "Path Rel Dir", "Path Rel File"]) $+    forAllValid $ \(parent :: Path Rel Dir) ->+      forAllValid $ \(child :: Path Rel File) -> func parent child++forAllPaths :: Testable a => String -> (forall b t. Path b t -> a) -> Spec+forAllPaths n func = do+  it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(path :: Path Abs Dir) -> func path+  it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(path :: Path Rel Dir) -> func path+  it (unwords [n, "Path Abs File"]) $ forAllValid $ \(path :: Path Abs File) -> func path+  it (unwords [n, "Path Rel File"]) $ forAllValid $ \(path :: Path Rel File) -> func path++parserSpec :: (Show p, Validity p) => (PLATFORM_PATH -> Maybe p) -> Spec+parserSpec parser =+  it "Produces valid paths when it succeeds" $+  forAllShrink genValid shrinkValid $ \path ->+    case parser path of+      Nothing -> pure ()+      Just p ->+        case prettyValidate p of+          Left err -> expectationFailure err+          Right _ -> pure ()
+ validity-test-ospath/Main.hs view
@@ -0,0 +1,21 @@+-- | Test suite.+module Main (main) where++import Test.Hspec+import Test.Hspec.QuickCheck (modifyMaxShrinks)++import qualified Posix+--import qualified Windows++-- | Test suite entry point, returns exit failure if any test fails.+main :: IO ()+main = hspec spec++-- | Test suite.+spec :: Spec+spec =+  modifyMaxShrinks (const 100) $+  parallel $ do+    Posix.spec+    -- See https://github.com/commercialhaskell/path/issues/74+    -- Windows.spec
+ validity-test-ospath/OsPath/Gen/Include.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-}++{-# OPTIONS_GHC -Wno-orphans #-}++module OsPath.Gen.PLATFORM_NAME where++import Data.Functor+import Prelude++import OsPath.PLATFORM_NAME+import OsPath.Internal.PLATFORM_NAME++import Data.GenValidity+import Data.Maybe (mapMaybe)+import Data.Validity.ByteString ()+import Data.Word (PLATFORM_WORD)+import System.OsPath.PLATFORM_NAME (PLATFORM_PATH)+import qualified System.OsPath.PLATFORM_NAME as OsPath+import Test.QuickCheck++import System.OsString.Compat.PLATFORM_NAME (PLATFORM_CHAR(..))+import qualified System.OsString.Compat.PLATFORM_NAME as OsString++instance Validity (Path Abs File) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateAbs p,+        validateFile p,+        declare "The path can be identically parsed as an absolute file path." $+          parseAbsFile fp == Just p+      ]++instance Validity (Path Rel File) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateRel p,+        validateFile p,+        declare "The path can be identically parsed as a relative file path." $+          parseRelFile fp == Just p+      ]++instance Validity (Path Abs Dir) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateAbs p,+        validateDirectory p,+        declare "The path can be identically parsed as an absolute directory path." $+          parseAbsDir fp == Just p+      ]++instance Validity (Path Rel Dir) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateRel p,+        validateDirectory p,+        declare "The path can be identically parsed as a relative directory path if it's not empty." $+          parseRelDir fp == Just p || OsString.null fp+      ]++instance Validity (SomeBase Dir)++instance Validity (SomeBase File)++instance GenValid (Path Abs File) where+  genValid = (Path . ([OsString.pstr|/|] <>) <$> genValid) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseAbsFile++instance GenValid (Path Abs Dir) where+  genValid = (Path . ([OsString.pstr|/|] <>) . (<> OsString.singleton OsPath.pathSeparator) <$> genValid) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseAbsDir++instance GenValid (Path Rel File) where+  genValid = (Path <$> genValid) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseRelFile++instance GenValid (Path Rel Dir) where+  genValid = (Path . (<> OsString.singleton OsPath.pathSeparator) <$> genValid) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseRelDir++instance GenValid (SomeBase Dir) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenValid (SomeBase File) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++validateCommon :: Path b t -> Validation+validateCommon (Path fp) = mconcat+  [ declare "System.FilePath considers the path valid if it's not empty." $+      OsPath.isValid fp || OsString.null fp+  , declare "The path does not contain a '..' path component." $+      not (hasParentDir fp)+  ]++validateDirectory :: Path b Dir -> Validation+validateDirectory (Path fp) = mconcat+  [ declare "The path has a trailing path separator if it's not empty." $+      OsPath.hasTrailingPathSeparator fp || OsString.null fp+  ]++validateFile :: Path b File -> Validation+validateFile (Path fp) = mconcat+  [ declare "The path has no trailing path separator." $+      not (OsPath.hasTrailingPathSeparator fp)+  , declare "The path does not equal \".\"" $+      fp /= [OsString.pstr|.|]+  , declare "The path does not end in /." $+      not ([OsString.pstr|/.|] `OsString.isSuffixOf` fp)+  ]++validateAbs :: Path Abs t -> Validation+validateAbs (Path fp) = mconcat+  [ declare "The path is absolute." $+      OsPath.isAbsolute fp+  ]++validateRel :: Path Rel t -> Validation+validateRel (Path fp) = mconcat+  [ declare "The path is relative." $+      OsPath.isRelative fp+  ]++shrinkValidWith :: (PLATFORM_PATH -> Maybe (Path a b)) -> Path a b -> [Path a b]+shrinkValidWith fun (Path f) = filter (/= Path f) . mapMaybe fun $ shrinkValid f++--------------------------------------------------------------------------------+-- Orphan instances++deriving via PLATFORM_WORD instance GenValid PLATFORM_CHAR+deriving via PLATFORM_WORD instance Validity PLATFORM_CHAR++-- | Generates PLATFORM_PATH_SINGLE with a high occurence of+-- 'OsPath.extSeparator' and 'OsPath.pathSeparators' characters. The resulting+-- paths are not guaranteed to be valid in the sense of 'OsPath.isValid'.+instance GenValid PLATFORM_PATH where+    genValid = OsPath.pack <$> listOf (frequency+        [ (2, genValid)+        , (1, elements (OsPath.extSeparator : OsPath.pathSeparators))+        ]+        )+    shrinkValid ospath =+      let (drive, relative) = OsPath.splitDrive ospath+          shrinkedWithoutDrive =+              map OsPath.pack+            . shrinkValid+            . OsPath.unpack+            $ relative+          shrinkedWithDrive =+            if OsString.null drive+            then []+            else map (drive <>) shrinkedWithoutDrive+      in+      shrinkedWithDrive <> shrinkedWithoutDrive++instance Validity PLATFORM_PATH
+ validity-test-ospath/OsPath/Gen/Posix.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME        Posix+#define PLATFORM_PATH        PosixPath+#define PLATFORM_PATH_SINGLE 'PosixPath'+#define PLATFORM_CHAR        PosixChar+#define PLATFORM_WORD        Word8+#include "Include.hs"
+ validity-test-ospath/OsPath/Gen/Windows.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME        Windows+#define PLATFORM_PATH        WindowsPath+#define PLATFORM_PATH_SINGLE 'WindowsPath'+#define PLATFORM_CHAR        WindowsChar+#define PLATFORM_WORD        Word16+#include "Include.hs"
+ validity-test-ospath/Posix.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME        Posix+#define PLATFORM_NAME_STRING "Posix"+#define PLATFORM_PATH        PosixPath+#include "Include.hs"
+ validity-test-ospath/Windows.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME        Windows+#define PLATFORM_NAME_STRING "Windows"+#define PLATFORM_PATH        WindowsPath+#include "Include.hs"
+ validity-test/Main.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++-- | Test suite.+module Main (main) where++import Path+import Path.Internal+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Test.Validity++import Path.Gen++-- | Test suite entry point, returns exit failure if any test fails.+main :: IO ()+main = hspec spec++-- | Test suite.+spec :: Spec+spec =+  modifyMaxShrinks (const 100) $+  parallel $ do+    genValidSpec @(Path Abs File)+    shrinkValidSpec @(Path Abs File)+    genValidSpec @(Path Rel File)+    shrinkValidSpec @(Path Rel File)+    genValidSpec @(Path Abs Dir)+    shrinkValidSpec @(Path Abs Dir)+    genValidSpec @(Path Rel Dir)+    shrinkValidSpec @(Path Rel Dir)+    genValidSpec @(SomeBase Dir)+    shrinkValidSpec @(SomeBase Dir)+    genValidSpec @(SomeBase File)+    shrinkValidSpec @(SomeBase File)+    describe "Parsing" $ do+      describe "Path Abs Dir" (parserSpec parseAbsDir)+      describe "Path Rel Dir" (parserSpec parseRelDir)+      describe "Path Abs File" (parserSpec parseAbsFile)+      describe "Path Rel File" (parserSpec parseRelFile)+      describe "SomeBase Dir" (parserSpec parseSomeDir)+      describe "SomeBase file" (parserSpec parseSomeFile)+    describe "Operations" $ do+      describe "(</>)" operationAppend+      describe "stripProperPrefix" operationStripDir+      describe "isProperPrefixOf" operationIsParentOf+      describe "parent" operationParent+      describe "splitDrive" operationSplitDrive+      describe "takeDrive" operationTakeDrive+      describe "filename" operationFilename+      describe "dirname" operationDirname+    describe "Extensions" extensionsSpec++-- | The 'filename' operation.+operationFilename :: Spec+operationFilename = do+  forAllDirs "filename (parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \parent ->+    forAllValid $ \file -> filename (parent </> file) `shouldBe` filename file+  forSomeDirs "filename (some:parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \someParent ->+    forAllValid $ \file ->+    prjSomeBase filename (mapSomeBase (</> file) someParent) `shouldBe` filename file+  it "produces a valid path on when passed a valid absolute path" $ do+    producesValid (filename :: Path Abs File -> Path Rel File)+  it "produces a valid path on when passed a valid relative path" $ do+    producesValid (filename :: Path Rel File -> Path Rel File)+  it "produces a valid filename when passed some valid base path" $+    producesValid (prjSomeBase filename :: SomeBase File -> Path Rel File)++-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+  forAllDirs "dirname parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \parent ->+    forAllValid $ \dir -> if dir == Path [] then pure () else dirname (parent </> dir) `shouldBe` dirname dir+  forSomeDirs "dirname (some:parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \someParent ->+    forAllValid $ \dir -> if dir == Path []+                          then pure ()+                          else prjSomeBase dirname (mapSomeBase (</> dir) someParent) `shouldBe` dirname dir+  it "produces a valid path on when passed a valid absolute path" $ do+    producesValid (dirname :: Path Abs Dir -> Path Rel Dir)+  it "produces a valid path on when passed a valid relative path" $ do+    producesValid (dirname :: Path Rel Dir -> Path Rel Dir)+  it "produces a valid path when passed some valid longer path" $+    producesValid (prjSomeBase dirname :: SomeBase Dir -> Path Rel Dir)++-- | The 'parent' operation.+operationParent :: Spec+operationParent = do+  it "produces a valid path on when passed a valid file path" $ do+    producesValid (parent :: Path Abs File -> Path Abs Dir)+  it "produces a valid path on when passed a valid directory path" $ do+    producesValid (parent :: Path Abs Dir -> Path Abs Dir)+  it "produces a valid path on when passed a valid abs file path" $ do+    producesValid (parent :: Path Abs File -> Path Abs Dir)+  it "produces a valid path on when passed a valid rel file path" $ do+    producesValid (parent :: Path Rel File -> Path Rel Dir)+  it "produces a valid path on when passed a valid abs directory path" $ do+    producesValid (parent :: Path Abs Dir -> Path Abs Dir)+  it "produces a valid path on when passed a valid rel directory path" $ do+    producesValid (parent :: Path Rel Dir -> Path Rel Dir)++-- | The 'splitDrive' operation.+operationSplitDrive :: Spec+operationSplitDrive = do+  it "produces valid paths on when passed a valid directory path" $ do+    producesValid (splitDrive :: Path Abs Dir -> (Path Abs Dir, Maybe (Path Rel Dir)))+  it "produces valid paths on when passed a valid file path" $ do+    producesValid (splitDrive :: Path Abs File -> (Path Abs Dir, Maybe (Path Rel File)))++-- | The 'takeDrive' operation.+operationTakeDrive :: Spec+operationTakeDrive = do+  it "produces a valid path on when passed a valid directory path" $ do+    producesValid (takeDrive :: Path Abs Dir -> Path Abs Dir)+  it "produces a valid path on when passed a valid file path" $ do+    producesValid (takeDrive :: Path Abs File -> Path Abs Dir)++-- | The 'isProperPrefixOf' operation.+operationIsParentOf :: Spec+operationIsParentOf = do+  forAllParentsAndChildren "isProperPrefixOf parent (parent </> child)" $ \parent child ->+    if child == Path []+      then True -- TODO do we always need this condition?+      else isProperPrefixOf parent (parent </> child)++-- | The 'stripProperPrefix' operation.+operationStripDir :: Spec+operationStripDir = do+  forAllParentsAndChildren "stripProperPrefix parent (parent </> child) = child" $ \parent child ->+    if child == Path []+      then pure () -- TODO do we always need this condition?+      else stripProperPrefix parent (parent </> child) `shouldBe` Just child+  it "produces a valid path on when passed a valid absolute file paths" $ do+    producesValid2+      (stripProperPrefix :: Path Abs Dir -> Path Abs File -> Maybe (Path Rel File))+  it "produces a valid path on when passed a valid absolute directory paths" $ do+    producesValid2+      (stripProperPrefix :: Path Abs Dir -> Path Abs Dir -> Maybe (Path Rel Dir))+  it "produces a valid path on when passed a valid relative file paths" $ do+    producesValid2+      (stripProperPrefix :: Path Rel Dir -> Path Rel File -> Maybe (Path Rel File))+  it "produces a valid path on when passed a valid relative directory paths" $ do+    producesValid2+      (stripProperPrefix :: Path Rel Dir -> Path Rel Dir -> Maybe (Path Rel Dir))++-- | The '</>' operation.+operationAppend :: Spec+operationAppend = do+  it "produces a valid path on when creating valid absolute file paths" $ do+    producesValid2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)+  it "produces a valid path on when creating valid absolute directory paths" $ do+    producesValid2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)+  it "produces a valid path on when creating valid relative file paths" $ do+    producesValid2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File)+  it "produces a valid path on when creating valid relative directory paths" $ do+    producesValid2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)++extensionsSpec :: Spec+extensionsSpec = do+  let addExtGensValidFile p =+        case addExtension p $(mkRelFile "x") of+          Nothing -> True+          Just _ ->+            case parseRelFile p of+              Nothing -> False+              _ -> True+  it "if addExtension a b succeeds then parseRelFile b succeeds - 1" $+    forAll genFilePath addExtGensValidFile+  -- skew the generated path towards a valid extension by prefixing a "."+  it "if addExtension a b succeeds then parseRelFile b succeeds - 2" $+    forAll genFilePath $ addExtGensValidFile . ("." ++)+  forAllFiles "Adding an extension is like adding the extension to the end if it succeeds" $ \file ->+    forAllValid $ \ext ->+      case addExtension ext file of+        Nothing -> pure () -- Fine+        Just p -> toFilePath p `shouldBe` toFilePath file ++ ext+  forAllFiles "splitExtension output joins to result in the original file" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (f, ext) -> toFilePath f ++ ext `shouldBe` toFilePath file+  forAllFiles "splitExtension generates a valid filename and valid extension" $ \file ->+    case splitExtension file of+      Nothing -> True+      Just (f, ext) ->+        case parseRelFile ext of+          Nothing -> False+          Just _ ->+            case parseRelFile (toFilePath f) of+              Nothing ->+                case parseAbsFile (toFilePath f) of+                  Nothing -> False+                  Just _ -> True+              Just _ -> True+  forAllFiles "splitExtension >=> uncurry addExtension . swap == return" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (f, ext) -> addExtension ext f `shouldBe` Just file+  forAllFiles "an extension that was added can be split off again" $ \file ->+    forAllValid $ \ext ->+      case addExtension ext file of+        Nothing -> pure () -- Fine+        Just p -> splitExtension p `shouldBe` Just (file, ext)+  forAllFiles "fileExtension == (fmap snd) . splitExtension" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (_, ext) -> fileExtension file `shouldBe` Just ext+  forAllFiles "an extension that was added is considered to be there" $ \file ->+    forAllValid $ \ext ->+      case addExtension ext file of+        Nothing -> pure () -- Fine+        Just p -> fileExtension p `shouldBe` Just ext+  forAllFiles "(fileExtension >=> flip replaceExtension file) file == return file" $ \file ->+    case fileExtension file of+      Nothing -> pure ()+      Just ext -> replaceExtension ext file `shouldBe` Just file++forAllFiles :: Testable a => String -> (forall b. Path b File -> a) -> Spec+forAllFiles n func = do+  it (unwords [n, "Path Abs File"]) $ forAllValid $ \(file :: Path Abs File) -> func file+  it (unwords [n, "Path Rel File"]) $ forAllValid $ \(file :: Path Rel File) -> func file++forAllDirs :: Testable a => String -> (forall b. Path b Dir -> a) -> Spec+forAllDirs n func = do+  it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(parent :: Path Abs Dir) -> func parent+  it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(parent :: Path Rel Dir) -> func parent++forSomeDirs :: Testable a => String -> (SomeBase Dir -> a) -> Spec+forSomeDirs n func = do+  it (unwords [n, "SomeBase Dir"]) $ forAllValid $ \(parent :: SomeBase Dir) -> func parent++forAllParentsAndChildren ::+     Testable a => String -> (forall b t. Path b Dir -> Path Rel t -> a) -> Spec+forAllParentsAndChildren n func = do+  it (unwords [n, "Path Abs Dir", "Path Rel Dir"]) $+    forAllValid $ \(parent :: Path Abs Dir) ->+      forAllValid $ \(child :: Path Rel Dir) -> func parent child+  it (unwords [n, "Path Rel Dir", "Path Rel Dir"]) $+    forAllValid $ \(parent :: Path Rel Dir) ->+      forAllValid $ \(child :: Path Rel Dir) -> func parent child+  it (unwords [n, "Path Abs Dir", "Path Rel File"]) $+    forAllValid $ \(parent :: Path Abs Dir) ->+      forAllValid $ \(child :: Path Rel File) -> func parent child+  it (unwords [n, "Path Rel Dir", "Path Rel File"]) $+    forAllValid $ \(parent :: Path Rel Dir) ->+      forAllValid $ \(child :: Path Rel File) -> func parent child++parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec+parserSpec parser =+  it "Produces valid paths when it succeeds" $+  forAllShrink genFilePath shrinkValid $ \path ->+    case parser path of+      Nothing -> pure ()+      Just p ->+        case prettyValidate p of+          Left err -> expectationFailure err+          Right _ -> pure ()
+ validity-test/Path/Gen.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Path.Gen where++import Data.Functor+import Prelude++import Path+import Path.Internal++import qualified System.FilePath as FilePath++import Data.GenValidity+import Data.List (isSuffixOf)+import Data.Maybe (mapMaybe)++import Test.QuickCheck++instance Validity (Path Abs File) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateAbs p,+        validateFile p,+        declare "The path can be identically parsed as an absolute file path." $+          parseAbsFile fp == Just p+      ]++instance Validity (Path Rel File) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateRel p,+        validateFile p,+        declare "The path can be identically parsed as a relative file path." $+          parseRelFile fp == Just p+      ]++instance Validity (Path Abs Dir) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateAbs p,+        validateDirectory p,+        declare "The path can be identically parsed as an absolute directory path." $+          parseAbsDir fp == Just p+      ]++instance Validity (Path Rel Dir) where+  validate p@(Path fp) =+    mconcat+      [ validateCommon p,+        validateRel p,+        validateDirectory p,+        declare "The path can be identically parsed as a relative directory path if it's not empty." $+          parseRelDir fp == Just p || fp == ""+      ]++instance Validity (SomeBase Dir)++instance Validity (SomeBase File)++validateCommon :: Path b t -> Validation+validateCommon (Path fp) = mconcat+  [ declare "System.FilePath considers the path valid if it's not empty." $ FilePath.isValid fp || fp == ""+  , declare "The path does not contain a '..' path component." $ not (hasParentDir fp)+  ]++validateDirectory :: Path b Dir -> Validation+validateDirectory (Path fp) = mconcat+  [ declare "The path has a trailing path separator if it's not empty." $ FilePath.hasTrailingPathSeparator fp || fp == ""+  ]++validateFile :: Path b File -> Validation+validateFile (Path fp) = mconcat+  [ declare "The path has no trailing path separator." $ not (FilePath.hasTrailingPathSeparator fp)+  , declare "The path does not equal \".\"" $ fp /= "."+  , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)+  ]++validateAbs :: Path Abs t -> Validation+validateAbs (Path fp) = mconcat+  [ declare "The path is absolute." $ FilePath.isAbsolute fp+  ]++validateRel :: Path Rel t -> Validation+validateRel (Path fp) = mconcat+  [ declare "The path is relative." $ FilePath.isRelative fp+  ]++instance GenValid (Path Abs File) where+  genValid = (Path . ('/' :) <$> genFilePath) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseAbsFile++instance GenValid (Path Abs Dir) where+  genValid = (Path . ('/' :) . (++ "/") <$> genFilePath) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseAbsDir++instance GenValid (Path Rel File) where+  genValid = (Path <$> genFilePath) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseRelFile++instance GenValid (Path Rel Dir) where+  genValid = (Path . (++ "/") <$> genFilePath) `suchThat` isValid+  shrinkValid = filter isValid . shrinkValidWith parseRelDir++instance GenValid (SomeBase Dir) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenValid (SomeBase File) where+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++-- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and+-- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to+-- be valid.+genFilePath :: Gen FilePath+genFilePath = listOf genPathyChar++genPathyChar :: Gen Char+genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")]++shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]+shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkValid f