packages feed

path 0.6.1 → 0.9.6

raw patch · 50 files changed

Files

CHANGELOG view
@@ -1,3 +1,71 @@+0.9.6+  * Support for `ospath`++0.9.5+  * Add `splitDrive`, `takeDrive`, `dropDrive` and `isDrive`.++  0.9.4 was an accidental release of the unreleased 0.9.3 without the appropriate changelog.++0.9.2+  * Data instances for Rel, Abs, File, and Dir.+  * Bump hashable upper bound to <1.5.++0.9.1+  * Support for genvalidity >=1.0.0.0+  * `mapSomeBase` and `prjSomeBase` for modifying or projecting SomeBase.++0.9.0+  * Fix inconsistencies on different platforms: [#166](https://github.com/commercialhaskell/path/issues/166)+  * `replaceProperPrefix`+  * Make it possible to use windows paths on posix and vice versa++0.8.0+  * Rerelease of 0.7.1 with better version number++0.7.1:+	* Test with GHC 8.8.2, 8.8.3, 8.10.1.+	* Export SomeBase constructor.+	* Fix Lift severe Lift instance bug++0.7.0:+	* BREAKING CHANGE: "fileExtension" now throws an exception if the file has no+		extension. You can use the result as a "Maybe" in pure+		code or handle the exception appropriately in any other monad.+	* Old extension operations "addFileExtension" and "setFileExtension" have+		been deprecated and replaced by "addExtension" and "replaceExtension"+		respectively with new behavior.+		ADAPTING YOUR CODE TO THIS CHANGE:+		* Code that sets an extension not starting with a "." e.g.  "foo", must+		  be changed such that it starts with a "." i.e. ".foo".+		* Code that sets multiple extensions in one go e.g. ".tar.gz" must be+		  changed to set them one at a time instead i.e. add ".tar" first and+		  then add ".gz".+		* Code that sets an extension starting with multiple dots e.g.+		  "..foo" must be changed such as to make the extra dots part of the+		  file name instead.+		Details:+		The new operations "addExtension" and "replaceExtension" accept only "valid"+		extension forms which is exactly the same as what "fileExtension" returns.+		A valid extension starts with a @.@ followed by one or more characters+		not including @.@ followed by zero or more @.@s in trailing position.+		This change allows extension operations to be principled following+		these laws:+		* flip addExtension file >=> fileExtension == return+		* (fileExtension >=> flip replaceExtension file) file == return file+	* Add splitExtension operation such that:+		* uncurry addExtension . swap >=> splitExtension == return+		* splitExtension >=> uncurry addExtension . swap == return+		* fileExtension == (fmap snd) . splitExtension@+	* Add 'Path.Posix' and 'Path.Windows' modules for manipulating+		Windows or Posix style paths independently of the current platform.+	* Add 'Lift' instance for 'Path'.+	* `Path.Windows` normalizes path separators throughout path,+		including immediately following drive letter.+	* `Path.Windows` handles UNC (`\\host\share\`) and Unicode (`\\?\C:\`) path+		without breaking the double-separator prefix.+	* Remove support for old GHC version. The oldest supported version+	is 8.2.+ 0.6.1: 	* Add 'addFileExtension' function and its operator form: (<.>). 	* Derive 'Eq' instance for 'PathException'.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015–2016, FP Complete+Copyright (c) 2015–2018, FP Complete All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,7 +1,6 @@ # Path -[![Travis Build Status](https://travis-ci.org/commercialhaskell/path.svg)](https://travis-ci.org/commercialhaskell/path)-[![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/commercialhaskell/path?svg=true)](https://ci.appveyor.com/project/chrisdone/path)+![CI](https://github.com/commercialhaskell/path/workflows/CI/badge.svg?branch=master) [![Hackage](https://img.shields.io/hackage/v/path.svg)](https://hackage.haskell.org/package/path) [![Stackage LTS](http://stackage.org/package/path/badge/lts)](http://stackage.org/lts/package/path) [![Stackage Nightly](http://stackage.org/package/path/badge/nightly)](http://stackage.org/nightly/package/path)@@ -92,7 +91,7 @@  ```haskell newtype Path b t = Path FilePath-  deriving (Typeable)+  deriving (Data, Typeable, Generic) ```  The type variables are:@@ -181,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: @@ -269,7 +267,7 @@ Stripping the parent directory from a path:  ```haskell-stripDir :: MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t)+stripProperPrefix :: MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) ```  ## Review@@ -401,7 +399,7 @@ ## Accepting user input  Sometimes you have user input that contains `../`. The solution we went with-is to have a function like `resolveDir`:+is to have a function like `resolveDir` (found in [`path-io`](http://hackage.haskell.org/package/path-io) package):  ```haskell resolveDir :: (MonadIO m, MonadThrow m)@@ -442,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. @@ -487,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,64 +1,192 @@+cabal-version:       3.0 name:                path-version:             0.6.1+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–2017 FP Complete+copyright:           2015–2018 FP Complete category:            System, Filesystem build-type:          Simple-cabal-version:       >=1.10-tested-with:         GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1-extra-source-files:  README.md, CHANGELOG+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-  ghc-options:       -Wall -O2-  exposed-modules:   Path, Path.Internal-  build-depends:     aeson-                   , base       >= 4.7     && < 5++  exposed-modules:   Path+                   , Path.Posix+                   , Path.Windows+                   , Path.Internal+                   , Path.Internal.Posix+                   , Path.Internal.Windows+                   , 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.9-                   , filepath   < 1.2.0.1  || >= 1.3-                   , hashable   >= 1.2     && < 1.3+                   , exceptions >= 0.4     && < 0.11+                   , hashable   >= 1.2     && < 1.5+                   , path:os-string-compat+                   , text                    , template-haskell-  default-language:  Haskell2010 +  if flag(os-string)+    build-depends:   filepath   >= 1.5+  else+    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-  hs-source-dirs:    test+                   , Common.Posix+                   , Common.Windows+                   , TH.Posix+                   , TH.Windows+   build-depends:     aeson-                   , base       >= 4.7     && < 5+                   , base                    , bytestring-                   , filepath   < 1.2.0.1  || >= 1.3+                   , exceptions+                   , filepath                    , hspec      >= 2.0     && < 3-                   , mtl        >= 2.0     && < 3                    , path-  default-language:  Haskell2010+                   , template-haskell +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.7 && < 5-                   , bytestring-                   , filepath   < 1.2.0.1  || >= 1.3-                   , genvalidity >= 0.3 && < 0.4-                   , genvalidity-property >= 0.0 && < 0.1+                   , base+                   , filepath+                   , genvalidity >= 1.0+                   , genvalidity-hspec >= 0.7                    , hspec      >= 2.0     && < 3-                   , mtl        >= 2.0     && < 3                    , path-                   , validity   >= 0.3.1.1 && < 0.4-  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.hs view
@@ -1,611 +1,15 @@ -- | This library provides a well-typed representation of paths in a filesystem--- directory tree.  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.+-- directory tree. ----- 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.+-- Both "Path.Posix" and "Path.Windows" provide the same interface. This+-- module will reexport the appropriate module for your platform.  {-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleInstances #-} -module Path-  (-- * Types-   Path-  ,Abs-  ,Rel-  ,File-  ,Dir-   -- * 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-  ,parent-  ,filename-  ,dirname-  ,fileExtension-  ,addFileExtension-  ,(<.>)-  ,setFileExtension-  ,(-<.>)-   -- * Parsing-  ,parseAbsDir-  ,parseRelDir-  ,parseAbsFile-  ,parseRelFile-  -- * Conversion-  ,toFilePath-  ,fromAbsDir-  ,fromRelDir-  ,fromAbsFile-  ,fromRelFile-  -- * TemplateHaskell constructors-  -- | These require the TemplateHaskell language extension.-  ,mkAbsDir-  ,mkRelDir-  ,mkAbsFile-  ,mkRelFile-  -- * Deprecated-  ,PathParseException-  ,stripDir-  ,isParentOf-  )-  where--import           Control.Exception (Exception)-import           Control.Monad-import           Control.Monad.Catch (MonadThrow(..))-import           Data.Aeson (FromJSON (..))-import qualified Data.Aeson.Types as Aeson-import           Data.Data-import           Data.List-import           Data.Maybe-import           Language.Haskell.TH-import           Language.Haskell.TH.Quote (QuasiQuoter(..))-import           Path.Internal-import qualified System.FilePath as FilePath------------------------------------------------------------------------------------- Types---- | An absolute path.-data Abs deriving (Typeable)---- | 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)---- | A file path.-data File deriving (Typeable)---- | A directory path.-data Dir deriving (Typeable)--instance FromJSON (Path Abs File) where-  parseJSON = parseJSONWith parseAbsFile-  {-# INLINE parseJSON #-}--instance FromJSON (Path Rel File) where-  parseJSON = parseJSONWith parseRelFile-  {-# INLINE parseJSON #-}--instance FromJSON (Path Abs Dir) where-  parseJSON = parseJSONWith parseAbsDir-  {-# INLINE parseJSON #-}--instance FromJSON (Path Rel Dir) where-  parseJSON = parseJSONWith parseRelDir-  {-# INLINE parseJSON #-}--parseJSONWith :: (Show e, FromJSON a)-              => (a -> Either e b) -> Aeson.Value -> Aeson.Parser b-parseJSONWith f x =-  do fp <- parseJSON x-     case f fp of-       Right p -> return p-       Left e -> fail (show e)-{-# INLINE parseJSONWith #-}---- | Exceptions that can occur during path operations.------ @since 0.6.0-data PathException-  = InvalidAbsDir FilePath-  | InvalidRelDir FilePath-  | InvalidAbsFile FilePath-  | InvalidRelFile FilePath-  | NotAProperPrefix FilePath FilePath-  deriving (Show,Eq,Typeable)-instance Exception PathException------------------------------------------------------------------------------------- QuasiQuoters--qq :: (String -> Q Exp) -> QuasiQuoter-qq quoteExp' =-  QuasiQuoter-  { quoteExp  = quoteExp'-  , 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 ++ \"/\" ++ y))@------ @$(mkAbsDir x) \<\/> $(mkRelFile y) = $(mkAbsFile (x ++ \"/\" ++ y))@------ @$(mkRelDir x) \<\/> $(mkRelDir y) = $(mkRelDir (x ++ \"/\" ++ y))@------ @$(mkRelDir x) \<\/> $(mkRelFile y) = $(mkRelFile (x ++ \"/\" ++ 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 stripPrefix p l of-    Nothing -> throwM (NotAProperPrefix p l)-    Just "" -> throwM (NotAProperPrefix p l)-    Just ok -> return (Path ok)---- | 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)---- | Take the parent path component from a path.------ The following properties hold:------ @--- parent (x \<\/> y) == x--- parent \"\/x\" == \"\/\"--- parent \"x\" == \".\"--- @------ On the root (absolute or relative), getting the parent is idempotent:------ @--- parent \"\/\" = \"\/\"--- parent \"\.\" = \"\.\"--- @----parent :: Path b t -> Path b Dir-parent (Path "") = Path ""-parent (Path fp) | FilePath.isDrive fp = Path fp-parent (Path fp) =-    Path-    $ normalizeDir-    $ FilePath.takeDirectory-    $ FilePath.dropTrailingPathSeparator fp---- | 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 (FilePath.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 "") = Path ""-dirname (Path l) | FilePath.isDrive l = Path ""-dirname (Path l) = Path (last (FilePath.splitPath l))---- | Get extension from given file path.------ @since 0.5.11-fileExtension :: Path b File -> String-fileExtension = FilePath.takeExtension . toFilePath---- | Add extension to given file path. Throws if the--- resulting filename does not parse.------ >>> addFileExtension "txt $(mkRelFile "foo")--- "foo.txt"--- >>> addFileExtension "symbols" $(mkRelFile "Data.List")--- "Data.List.symbols"--- >>> addFileExtension ".symbols" $(mkRelFile "Data.List")--- "Data.List.symbols"--- >>> addFileExtension "symbols" $(mkRelFile "Data.List.")--- "Data.List..symbols"--- >>> addFileExtension ".symbols" $(mkRelFile "Data.List.")--- "Data.List..symbols"--- >>> addFileExtension "evil/" $(mkRelFile "Data.List")--- *** Exception: InvalidRelFile "Data.List.evil/"------ @since 0.6.1-addFileExtension :: MonadThrow m-  => 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 FilePath.isAbsolute path-    then liftM coercePath (parseAbsFile (FilePath.addExtension path ext))-    else liftM coercePath (parseRelFile (FilePath.addExtension path ext))-  where coercePath :: Path a b -> Path a' b'-        coercePath (Path a) = Path a---- | A synonym for 'addFileExtension' in the form of an operator.--- See more examples there.------ >>> $(mkRelFile "Data.List") <.> "symbols"--- "Data.List.symbols"--- >>> $(mkRelFile "Data.List") <.> "evil/"--- *** Exception: InvalidRelFile "Data.List.evil/"------ @since 0.6.1-infixr 7 <.>-(<.>) :: MonadThrow m-  => Path b File       -- ^ Old file name-  -> 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-setFileExtension :: MonadThrow m-  => 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 FilePath.isAbsolute path-    then liftM coercePath (parseAbsFile (FilePath.replaceExtension path ext))-    else liftM coercePath (parseRelFile (FilePath.replaceExtension path ext))-  where coercePath :: Path a b -> Path a' b'-        coercePath (Path a) = Path a---- | A synonym for 'setFileExtension' in the form of an operator.------ @since 0.6.0-infixr 7 -<.>-(-<.>) :: MonadThrow m-  => Path b File       -- ^ Old file name-  -> String            -- ^ Extension to set-  -> m (Path b File)   -- ^ New file name with the desired extension-(-<.>) = flip setFileExtension------------------------------------------------------------------------------------- Parsers---- | Convert an absolute 'FilePath' 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 'System.FilePath.isValid')----parseAbsDir :: MonadThrow m-            => FilePath -> m (Path Abs Dir)-parseAbsDir filepath =-  if FilePath.isAbsolute filepath &&-     not (hasParentDir filepath) &&-     FilePath.isValid filepath-     then return (Path (normalizeDir filepath))-     else throwM (InvalidAbsDir filepath)---- | Convert a relative 'FilePath' 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 'System.FilePath.isValid')----parseRelDir :: MonadThrow m-            => FilePath -> m (Path Rel Dir)-parseRelDir filepath =-  if not (FilePath.isAbsolute filepath) &&-     not (hasParentDir filepath) &&-     not (null filepath) &&-     FilePath.isValid filepath-     then return (Path (normalizeDir filepath))-     else throwM (InvalidRelDir filepath)---- | Convert an absolute 'FilePath' 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 'System.FilePath.isValid')----parseAbsFile :: MonadThrow m-             => FilePath -> m (Path Abs File)-parseAbsFile filepath =-  case validAbsFile filepath of-    True-      | normalized <- normalizeFilePath filepath-      , validAbsFile normalized ->-        return (Path normalized)-    _ -> throwM (InvalidAbsFile filepath)---- | Is the string a valid absolute file?-validAbsFile :: FilePath -> Bool-validAbsFile filepath =-  FilePath.isAbsolute filepath &&-  not (FilePath.hasTrailingPathSeparator filepath) &&-  not (hasParentDir filepath) &&-  FilePath.isValid filepath---- | Convert a relative 'FilePath' 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 'System.FilePath.isValid')----parseRelFile :: MonadThrow m-             => FilePath -> m (Path Rel File)-parseRelFile filepath =-  case validRelFile filepath of-    True-      | normalized <- normalizeFilePath filepath-      , validRelFile normalized -> return (Path normalized)-    _ -> throwM (InvalidRelFile filepath)---- | Is the string a valid relative file?-validRelFile :: FilePath -> Bool-validRelFile filepath =-  not-    (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&-  not (null filepath) &&-  not (hasParentDir filepath) &&-  filepath /= "." && FilePath.isValid filepath------------------------------------------------------------------------------------- Conversion---- | Convert absolute path to directory to 'FilePath' type.-fromAbsDir :: Path Abs Dir -> FilePath-fromAbsDir = toFilePath---- | Convert relative path to directory to 'FilePath' type.-fromRelDir :: Path Rel Dir -> FilePath-fromRelDir = toFilePath---- | Convert absolute path to file to 'FilePath' type.-fromAbsFile :: Path Abs File -> FilePath-fromAbsFile = toFilePath---- | Convert relative path to file to 'FilePath' type.-fromRelFile :: Path Rel File -> FilePath-fromRelFile = toFilePath------------------------------------------------------------------------------------- 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 :: FilePath -> Q Exp-mkAbsDir s =-  case parseAbsDir s of-    Left err -> error (show err)-    Right (Path str) ->-      [|Path $(return (LitE (StringL str))) :: Path Abs Dir|]---- | Make a 'Path' 'Rel' 'Dir'.-mkRelDir :: FilePath -> Q Exp-mkRelDir s =-  case parseRelDir s of-    Left err -> error (show err)-    Right (Path str) ->-      [|Path $(return (LitE (StringL str))) :: Path Rel Dir|]---- | 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 :: FilePath -> Q Exp-mkAbsFile s =-  case parseAbsFile s of-    Left err -> error (show err)-    Right (Path str) ->-      [|Path $(return (LitE (StringL str))) :: Path Abs File|]---- | Make a 'Path' 'Rel' 'File'.-mkRelFile :: FilePath -> Q Exp-mkRelFile s =-  case parseRelFile s of-    Left err -> error (show err)-    Right (Path str) ->-      [|Path $(return (LitE (StringL str))) :: Path Rel File|]------------------------------------------------------------------------------------- Internal functions---- | Internal use for normalizing a directory.-normalizeDir :: FilePath -> FilePath-normalizeDir =-      normalizeRelDir-    . FilePath.addTrailingPathSeparator-    . normalizeFilePath-  where-      -- Represent a "." in relative dir path as "" internally so that it-      -- composes without having to renormalize the path.-      normalizeRelDir p | p == relRootFP = ""-      normalizeRelDir p = p--normalizeFilePath :: FilePath -> FilePath-#if defined(mingw32_HOST_OS) || defined(__MINGW32__) || MIN_VERSION_filepath(1,4,0)-normalizeFilePath = FilePath.normalise+#if defined(mingw32_HOST_OS)+module Path(module Path.Windows) where+import Path.Windows #else-normalizeFilePath = normalizeLeadingSeparators . FilePath.normalise-    where-        sep = FilePath.pathSeparator-        normalizeLeadingSeparators (x1:x2:xs) | x1 == sep && x2 == sep-            = normalizeLeadingSeparators (sep:xs)-        normalizeLeadingSeparators x = x+module Path(module Path.Posix) where+import Path.Posix #endif------------------------------------------------------------------------------------- Deprecated--{-# 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/Path/Include.hs view
@@ -0,0 +1,961 @@+-- 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 DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++module Path.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+  ,toFilePath+  ,fromAbsDir+  ,fromRelDir+  ,fromAbsFile+  ,fromRelFile+  ,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 (liftM, when)+import           Control.Monad.Catch (MonadThrow(..))+import           Data.Aeson (FromJSON (..), FromJSONKey(..), ToJSON(..))+import qualified Data.Aeson.Types as Aeson+import           Data.Data+import qualified Data.Text as T+import           Data.Hashable+import qualified Data.List as L+import           Data.Maybe+import           GHC.Generics (Generic)+import           Language.Haskell.TH+import           Language.Haskell.TH.Syntax (lift)+import           Language.Haskell.TH.Quote (QuasiQuoter(..))+import           Path.Internal.PLATFORM_NAME+import qualified System.FilePath.PLATFORM_NAME as FilePath++--------------------------------------------------------------------------------+-- 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)++instance FromJSON (Path Abs File) where+  parseJSON = parseJSONWith parseAbsFile+  {-# INLINE parseJSON #-}++instance FromJSON (Path Rel File) where+  parseJSON = parseJSONWith parseRelFile+  {-# INLINE parseJSON #-}++instance FromJSON (Path Abs Dir) where+  parseJSON = parseJSONWith parseAbsDir+  {-# INLINE parseJSON #-}++instance FromJSON (Path Rel Dir) where+  parseJSON = parseJSONWith parseRelDir+  {-# INLINE parseJSON #-}++parseJSONWith :: (Show e, FromJSON a)+              => (a -> Either e b) -> Aeson.Value -> Aeson.Parser b+parseJSONWith f x =+  do fp <- parseJSON x+     case f fp of+       Right p -> return p+       Left e -> fail (show e)+{-# INLINE parseJSONWith #-}++instance FromJSONKey (Path Abs File) where+  fromJSONKey = fromJSONKeyWith parseAbsFile+  {-# INLINE fromJSONKey #-}++instance FromJSONKey (Path Rel File) where+  fromJSONKey = fromJSONKeyWith parseRelFile+  {-# INLINE fromJSONKey #-}++instance FromJSONKey (Path Abs Dir) where+  fromJSONKey = fromJSONKeyWith parseAbsDir+  {-# INLINE fromJSONKey #-}++instance FromJSONKey (Path Rel Dir) where+  fromJSONKey = fromJSONKeyWith parseRelDir+  {-# INLINE fromJSONKey #-}++fromJSONKeyWith :: (Show e)+                => (String -> Either e b) -> Aeson.FromJSONKeyFunction b+fromJSONKeyWith f =+  Aeson.FromJSONKeyTextParser $ \t ->+    case f (T.unpack t) of+      Left e -> fail (show e)+      Right rf -> pure rf++{-# INLINE fromJSONKeyWith #-}++-- | Exceptions that can occur during path operations.+--+-- @since 0.6.0+data PathException+  = InvalidAbsDir FilePath+  | InvalidRelDir FilePath+  | InvalidAbsFile FilePath+  | InvalidRelFile FilePath+  | InvalidFile FilePath+  | InvalidDir FilePath+  | NotAProperPrefix FilePath FilePath+  | HasNoExtension FilePath+  | InvalidExtension String+  deriving (Show,Eq,Typeable)++instance Exception PathException where+  displayException (InvalidExtension ext) = concat+    [ "Invalid extension ["+    , 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 :: (String -> Q Exp) -> QuasiQuoter+qq quoteExp' =+  QuasiQuoter+  { quoteExp  = quoteExp'+  , 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 ++ \"/\" ++ y))@+--+-- @$(mkAbsDir x) \<\/> $(mkRelFile y) = $(mkAbsFile (x ++ \"/\" ++ y))@+--+-- @$(mkRelDir x) \<\/> $(mkRelDir y) = $(mkRelDir (x ++ \"/\" ++ y))@+--+-- @$(mkRelDir x) \<\/> $(mkRelFile y) = $(mkRelFile (x ++ \"/\" ++ 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 L.stripPrefix p l of+    Nothing -> throwM (NotAProperPrefix p l)+    Just "" -> throwM (NotAProperPrefix p l)+    Just ok -> return (Path ok)++-- | 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 \"\/x\" == \"\/\"+-- parent \"x\" == \".\"+-- @+--+-- On the root (absolute or relative), getting the parent is idempotent:+--+-- @+-- parent \"\/\" = \"\/\"+-- parent \"\.\" = \"\.\"+-- @+--+parent :: Path b t -> Path b Dir+parent (Path "") = Path ""+parent (Path fp) | FilePath.isDrive fp = Path fp+parent (Path fp) =+    Path+    $ normalizeDir+    $ FilePath.takeDirectory+    $ FilePath.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) = FilePath.splitDrive fp+        mRest = if 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 (FilePath.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 "") = Path ""+dirname (Path l) | FilePath.isDrive l = Path ""+dirname (Path l) = Path (last (FilePath.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"    ), ".foo"  )+-- >>> splitExtension $(mkRelFile "name.foo."    ) == Just ($(mkRelFile "name"    ), ".foo." )+-- >>> splitExtension $(mkRelFile "name.foo.."   ) == Just ($(mkRelFile "name"    ), ".foo..")+-- >>> splitExtension $(mkRelFile "name.bar.foo" ) == Just ($(mkRelFile "name.bar"), ".foo"  )+-- >>> splitExtension $(mkRelFile ".name.foo"    ) == Just ($(mkRelFile ".name"   ), ".foo"  )+-- >>> splitExtension $(mkRelFile "name..foo"    ) == Just ($(mkRelFile "name."   ), ".foo"  )+-- >>> splitExtension $(mkRelFile "....foo"      ) == Just ($(mkRelFile "..."     ), ".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, String)+splitExtension (Path fpath) =+    if nameDot == [] || ext == []+    then throwM $ HasNoExtension fpath+    else let fname = init nameDot+         in if fname == [] || fname == "." || fname == ".."+            then throwM $ HasNoExtension fpath+            else return ( Path (normalizeDrive drv ++ dir ++ fname)+                        , FilePath.extSeparator : ext+                        )+    where++    -- trailing separators are ignored for the split and considered part of the+    -- second component in the split.+    splitLast isSep str =+        let rstr = reverse str+            notSep = not . isSep+            name = (dropWhile notSep . dropWhile isSep) rstr+            trailingSeps = takeWhile isSep rstr+            xtn  = (takeWhile notSep . dropWhile isSep) rstr+        in (reverse name, reverse xtn ++ trailingSeps)+    normalizeDrive+      | isWindows = normalizeTrailingSeps+      | otherwise = id++    (drv, pth)     = FilePath.splitDrive fpath+    (dir, file)    = splitLast FilePath.isPathSeparator pth+    (nameDot, ext) = splitLast FilePath.isExtSeparator file++-- | 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 String+fileExtension = (liftM snd) . splitExtension++-- | Add extension to given file path.+--+-- >>> addExtension ".foo"   $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo"    )+-- >>> addExtension ".foo."  $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo."   )+-- >>> addExtension ".foo.." $(mkRelFile "name"     ) == Just $(mkRelFile "name.foo.."  )+-- >>> addExtension ".foo"   $(mkRelFile "name.bar" ) == Just $(mkRelFile "name.bar.foo")+-- >>> addExtension ".foo"   $(mkRelFile ".name"    ) == Just $(mkRelFile ".name.foo"   )+-- >>> addExtension ".foo"   $(mkRelFile "name."    ) == Just $(mkRelFile "name..foo"   )+-- >>> addExtension ".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 "foo"      $(mkRelFile "name")+-- >>> addExtension "..foo"    $(mkRelFile "name")+-- >>> addExtension ".foo.bar" $(mkRelFile "name")+-- >>> addExtension ".foo/bar" $(mkRelFile "name")+--+-- @since 0.7.0+addExtension :: MonadThrow m+  => 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+    validateExtension ext+    return $ Path (path ++ ext)++    where++    validateExtension ex@(sep:xs) = do+        -- has to start with a "."+        when (not $ FilePath.isExtSeparator sep) $+            throwM $ InvalidExtension ex++        -- just a "." is not a valid extension+        when (xs == []) $+            throwM $ InvalidExtension ex++        -- cannot have path separators+        when (any FilePath.isPathSeparator xs) $+            throwM $ InvalidExtension ex++        -- All "."s is not a valid extension+        let ys = dropWhile FilePath.isExtSeparator (reverse xs)+        when (ys == []) $+            throwM $ InvalidExtension ex++        -- Cannot have "."s except in trailing position+        when (any FilePath.isExtSeparator ys) $+            throwM $ InvalidExtension ex++        -- must be valid as a filename+        _ <- parseRelFile ex+        return ()+    validateExtension ex = throwM $ InvalidExtension ex++-- | Add extension to given file path. Throws if the+-- resulting filename does not parse.+--+-- >>> addFileExtension "txt $(mkRelFile "foo")+-- "foo.txt"+-- >>> addFileExtension "symbols" $(mkRelFile "Data.List")+-- "Data.List.symbols"+-- >>> addFileExtension ".symbols" $(mkRelFile "Data.List")+-- "Data.List.symbols"+-- >>> addFileExtension "symbols" $(mkRelFile "Data.List.")+-- "Data.List..symbols"+-- >>> addFileExtension ".symbols" $(mkRelFile "Data.List.")+-- "Data.List..symbols"+-- >>> addFileExtension "evil/" $(mkRelFile "Data.List")+-- *** Exception: InvalidRelFile "Data.List.evil/"+--+-- @since 0.6.1+{-# DEPRECATED addFileExtension "Please use addExtension instead." #-}+addFileExtension :: MonadThrow m+  => 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 FilePath.isAbsolute path+    then liftM coercePath (parseAbsFile (FilePath.addExtension path ext))+    else liftM coercePath (parseRelFile (FilePath.addExtension path ext))+  where coercePath :: Path a b -> Path a' b'+        coercePath (Path a) = Path a++-- | A synonym for 'addFileExtension' in the form of an infix operator.+-- See more examples there.+--+-- >>> $(mkRelFile "Data.List") <.> "symbols"+-- "Data.List.symbols"+-- >>> $(mkRelFile "Data.List") <.> "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+  -> String            -- ^ Extension to add+  -> m (Path b File)   -- ^ New file name with the desired extension added at the end+(<.>) = flip addFileExtension++-- | 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+  => 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)++-- | 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+  => 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 FilePath.isAbsolute path+    then liftM coercePath (parseAbsFile (FilePath.replaceExtension path ext))+    else liftM coercePath (parseRelFile (FilePath.replaceExtension path ext))+  where coercePath :: Path a b -> Path a' b'+        coercePath (Path a) = Path a++-- | 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+  -> String            -- ^ Extension to set+  -> m (Path b File)   -- ^ New file name with the desired extension+(-<.>) = flip setFileExtension++--------------------------------------------------------------------------------+-- Parsers++-- | Convert an absolute 'FilePath' 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 'FilePath.isValid')+--+parseAbsDir :: MonadThrow m+            => FilePath -> m (Path Abs Dir)+parseAbsDir filepath =+  if FilePath.isAbsolute filepath &&+     not (hasParentDir filepath) &&+     FilePath.isValid filepath+     then return (Path (normalizeDir filepath))+     else throwM (InvalidAbsDir filepath)++-- | Convert a relative 'FilePath' 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 'FilePath.isValid')+-- * is all path separators+--+parseRelDir :: MonadThrow m+            => FilePath -> m (Path Rel Dir)+parseRelDir filepath =+  if not (FilePath.isAbsolute filepath) &&+     not (hasParentDir filepath) &&+     not (null filepath) &&+     not (all FilePath.isPathSeparator filepath) &&+     FilePath.isValid filepath+     then return (Path (normalizeDir filepath))+     else throwM (InvalidRelDir filepath)++-- | Convert an absolute 'FilePath' 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 'FilePath.isValid')+--+parseAbsFile :: MonadThrow m+             => FilePath -> m (Path Abs File)+parseAbsFile filepath =+  case validAbsFile filepath of+    True+      | normalized <- normalizeFilePath filepath+      , validAbsFile normalized ->+        return (Path normalized)+    _ -> throwM (InvalidAbsFile filepath)++-- | Is the string a valid absolute file?+validAbsFile :: FilePath -> Bool+validAbsFile filepath =+  FilePath.isAbsolute filepath &&+  not (FilePath.hasTrailingPathSeparator filepath) &&+  not (hasParentDir filepath) &&+  FilePath.isValid filepath++-- | Convert a relative 'FilePath' 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 'FilePath.isValid')+--+parseRelFile :: MonadThrow m+             => FilePath -> m (Path Rel File)+parseRelFile filepath =+  case validRelFile filepath of+    True+      | normalized <- normalizeFilePath filepath+      , validRelFile normalized -> return (Path normalized)+    _ -> throwM (InvalidRelFile filepath)++-- | Is the string a valid relative file?+validRelFile :: FilePath -> Bool+validRelFile filepath =+  not+    (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&+  not (null filepath) &&+  not (hasParentDir filepath) &&+  filepath /= "." && FilePath.isValid filepath++--------------------------------------------------------------------------------+-- Conversion++-- | Convert absolute path to directory to 'FilePath' type.+fromAbsDir :: Path Abs Dir -> FilePath+fromAbsDir = toFilePath++-- | Convert relative path to directory to 'FilePath' type.+fromRelDir :: Path Rel Dir -> FilePath+fromRelDir = toFilePath++-- | Convert absolute path to file to 'FilePath' type.+fromAbsFile :: Path Abs File -> FilePath+fromAbsFile = toFilePath++-- | Convert relative path to file to 'FilePath' type.+fromRelFile :: Path Rel File -> FilePath+fromRelFile = toFilePath++--------------------------------------------------------------------------------+-- 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 :: FilePath -> Q Exp+mkAbsDir = either (error . show) lift . parseAbsDir++-- | Make a 'Path' 'Rel' 'Dir'.+mkRelDir :: FilePath -> Q Exp+mkRelDir = either (error . show) 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 :: FilePath -> Q Exp+mkAbsFile = either (error . show) lift . parseAbsFile++-- | Make a 'Path' 'Rel' 'File'.+mkRelFile :: FilePath -> Q Exp+mkRelFile = either (error . show) lift . parseRelFile++--------------------------------------------------------------------------------+-- Internal functions++-- | Normalizes directory path with platform-specific rules.+normalizeDir :: FilePath -> FilePath+normalizeDir =+      normalizeRelDir+    . FilePath.addTrailingPathSeparator+    . normalizeFilePath+  where -- Represent a "." in relative dir path as "" internally so that it+        -- composes without having to renormalize the path.+        normalizeRelDir p+          | 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 []+  where normSeps ch [] = [ch]+        normSeps ch path@(p0:_)+          | FilePath.isPathSeparator ch && FilePath.isPathSeparator p0 = path+          | FilePath.isPathSeparator ch = FilePath.pathSeparator:path+          | otherwise = ch:path++-- | 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 :: FilePath -> FilePath+normalizeWindowsSeps path = normLeadingSeps ++ normalizeAllSeps rest+  where (leadingSeps, rest) = span FilePath.isPathSeparator path+        normLeadingSeps = replicate (min 2 (length leadingSeps)) FilePath.pathSeparator++-- | Applies platform-specific sep normalization following @FilePath.normalise@.+normalizeFilePath :: FilePath -> FilePath+normalizeFilePath+  | 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+-- 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 ToJSON (SomeBase t) where+  toJSON = toJSON . fromSomeBase+  {-# INLINE toJSON #-}+#if MIN_VERSION_aeson(0,10,0)+  toEncoding = toEncoding . fromSomeBase+  {-# INLINE toEncoding #-}+#endif++instance Hashable (SomeBase t) where+  -- See 'Hashable' 'Path' instance for details.+  hashWithSalt n path = hashWithSalt n (fromSomeBase path)++instance FromJSON (SomeBase Dir) where+  parseJSON = parseJSONWith parseSomeDir+  {-# INLINE parseJSON #-}++instance FromJSON (SomeBase File) where+  parseJSON = parseJSONWith parseSomeFile+  {-# INLINE parseJSON #-}++-- | Helper to project the contents out of a SomeBase object.+--+-- >>> prjSomeBase toFilePath (Abs [absfile|/foo/bar/cow.moo|]) == "/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 'FilePath'.+fromSomeBase :: SomeBase t -> FilePath+fromSomeBase = prjSomeBase toFilePath++-- | Convert a valid directory to a 'FilePath'.+fromSomeDir :: SomeBase Dir -> FilePath+fromSomeDir = fromSomeBase++-- | Convert a valid file to a 'FilePath'.+fromSomeFile :: SomeBase File -> FilePath+fromSomeFile = fromSomeBase++-- | Convert an absolute or relative 'FilePath' 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 'FilePath.isValid')+parseSomeDir :: MonadThrow m => FilePath -> m (SomeBase Dir)+parseSomeDir fp = maybe (throwM (InvalidDir fp)) pure+                $ (Abs <$> parseAbsDir fp)+              <|> (Rel <$> parseRelDir fp)++-- | Convert an absolute or relative 'FilePath' 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 'FilePath.isValid')+parseSomeFile :: MonadThrow m => FilePath -> m (SomeBase File)+parseSomeFile fp = maybe (throwM (InvalidFile fp)) pure+                 $ (Abs <$> parseAbsFile fp)+               <|> (Rel <$> parseRelFile fp)++--------------------------------------------------------------------------------+-- Deprecated++{-# 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/Path/Internal.hs view
@@ -1,105 +1,9 @@-{-# LANGUAGE CPP                #-}-{-# LANGUAGE DeriveDataTypeable #-}---- | Internal types and functions.--module Path.Internal-  ( Path(..)-  , hasParentDir-  , relRootFP-  , toFilePath-  )-  where--import Control.DeepSeq (NFData (..))-import Data.Aeson (ToJSON (..))-import Data.Data-import Data.Hashable-import Data.List-import qualified System.FilePath as FilePath---- | 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 is a string. The string 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 FilePath-  deriving (Typeable)---- | String equality.------ The following property holds:------ @show x == show y ≡ x == y@-instance Eq (Path b t) where-  (==) (Path x) (Path y) = x == y---- | 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---- | Normalized file path representation for the relative path root-relRootFP :: FilePath-relRootFP = '.' : [FilePath.pathSeparator]---- | Convert to a 'FilePath' type.------ All directories have a trailing slash, so if you want no trailing--- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from--- the filepath package.-toFilePath :: Path b t -> FilePath-toFilePath (Path []) = relRootFP-toFilePath (Path x)  = x---- | Same as 'show . Path.toFilePath'.------ The following property holds:------ @x == y ≡ show x == show y@-instance Show (Path b t) where-  show = show . toFilePath--instance NFData (Path b t) where-  rnf (Path x) = rnf x+{-# LANGUAGE CPP #-} -instance ToJSON (Path b t) where-  toJSON = toJSON . toFilePath-  {-# INLINE toJSON #-}-#if MIN_VERSION_aeson(0,10,0)-  toEncoding = toEncoding . toFilePath-  {-# INLINE toEncoding #-}+#if defined(mingw32_HOST_OS)+module Path.Internal(module Path.Internal.Windows) where+import Path.Internal.Windows+#else+module Path.Internal(module Path.Internal.Posix) where+import Path.Internal.Posix #endif--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 (toFilePath path)---- | 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 :: FilePath -> Bool-hasParentDir filepath' =-     (filepath' == "..") ||-     ("/.." `isSuffixOf` filepath) ||-     ("/../" `isInfixOf` filepath) ||-     ("../" `isPrefixOf` filepath)-  where-    filepath =-        case FilePath.pathSeparator of-            '/' -> filepath'-            x   -> map (\y -> if x == y then '/' else y) filepath'
+ src/Path/Internal/Include.hs view
@@ -0,0 +1,147 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows+--     IS_WINDOWS    = 0 | 1++{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell    #-}++-- | Internal types and functions.++module Path.Internal.PLATFORM_NAME+  ( Path(..)+  , relRootFP+  , toFilePath+  , hasParentDir+  , isWindows+  )+  where++import Control.DeepSeq (NFData (..))+import Data.Aeson (ToJSON (..), ToJSONKey(..))+import Data.Aeson.Types (toJSONKeyText)+import qualified Data.Text as T (pack)+import GHC.Generics (Generic)+import Data.Data+import Data.Hashable+import qualified Data.List as L+import qualified Language.Haskell.TH.Syntax as TH+import qualified System.FilePath.PLATFORM_NAME as FilePath++-- | 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 is a string. The string 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 FilePath+  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++-- | 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++-- | Normalized file path representation for the relative path root+relRootFP :: FilePath+relRootFP = '.' : [FilePath.pathSeparator]++-- | Convert to a 'FilePath' type.+--+-- All directories have a trailing slash, so if you want no trailing+-- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from+-- the filepath package.+toFilePath :: Path b t -> FilePath+toFilePath (Path []) = relRootFP+toFilePath (Path x)  = x++-- | 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 :: FilePath -> Bool+hasParentDir filepath' =+     (filepath' == "..") ||+     ("/.." `L.isSuffixOf` filepath) ||+     ("/../" `L.isInfixOf` filepath) ||+     ("../" `L.isPrefixOf` filepath)+  where+    filepath =+        case FilePath.pathSeparator of+            '/' -> filepath'+            x   -> map (\y -> if x == y then '/' else y) filepath'++-- | Same as 'show . Path.toFilePath'.+--+-- The following property holds:+--+-- @x == y ≡ show x == show y@+instance Show (Path b t) where+  show = show . toFilePath++instance NFData (Path b t) where+  rnf (Path x) = rnf x++instance ToJSON (Path b t) where+  toJSON = toJSON . toFilePath+  {-# INLINE toJSON #-}+#if MIN_VERSION_aeson(0,10,0)+  toEncoding = toEncoding . toFilePath+  {-# INLINE toEncoding #-}+#endif++instance ToJSONKey (Path b t) where+  toJSONKey = toJSONKeyText $ T.pack . toFilePath++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 (toFilePath path)++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 $(pure (TH.LitE (TH.StringL 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++isWindows :: Bool+#if IS_WINDOWS+isWindows = True+#else+isWindows = False+#endif+{-# INLINE isWindows #-}
+ src/Path/Internal/Posix.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME   Posix+#define IS_WINDOWS      0+#include "Include.hs"
+ src/Path/Internal/Windows.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME   Windows+#define IS_WINDOWS      1+#include "Include.hs"
+ src/Path/Posix.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME   Posix+#include "Include.hs"
+ src/Path/Windows.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME   Windows+#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
@@ -0,0 +1,335 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows++{-# LANGUAGE RankNTypes #-}++-- | 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 qualified System.FilePath.PLATFORM_NAME as FilePath+import Test.Hspec++import Path.Internal.PLATFORM_NAME+import Path.PLATFORM_NAME++currentDir :: Path Rel Dir+currentDir = (fromJust . parseRelDir) "."++drives :: NonEmpty (Path Abs Dir)+drives = (fromJust . traverse parseAbsDir) drives_++relDir :: Path Rel Dir+relDir = (fromJust . parseRelDir) "directory"++relFile :: Path Rel File+relFile = (fromJust . parseRelFile) "file"++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++-- | 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 . toFilePath . 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 absDir == 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) == 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_ 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 filepath = dir ++ [FilePath.pathSeparator] ++ file+              runTests parseRelFile filepath ext++    describe "Absolute dir paths" $+      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 " ++ 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)+        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 :: [FilePath]+    filenames =+        [ "name"+        , "name."+        , "name.."+        , ".name"+        , "..name"+        , "name.name"+        , "name..name"+        , "..."+        ]++    dirnames :: [FilePath]+    dirnames = filenames ++ ["."]++    invalidExtensions :: [String]+    invalidExtensions =+        [ ""+        , "."+        , "x"+        , ".."+        , "..."+        , "xy"+        , "foo"+        , "foo."+        , "foo.."+        , "..foo"+        , "...foo"+        , ".foo.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
@@ -0,0 +1,7 @@+{-# LANGUAGE CPP #-}++#define PLATFORM_NAME Posix+#include "Include.hs"++drives_ :: NonEmpty FilePath+drives_ = NonEmpty.singleton "/"
+ test/Common/Windows.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}++#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/Main.hs view
@@ -1,15 +1,12 @@-{-# LANGUAGE CPP #-}- module Main (main) where -#ifdef mingw32_HOST_OS-import Windows (spec)-#else-import Posix (spec)-#endif+import qualified Windows+import qualified Posix  import Test.Hspec  -- | Test suite entry point, returns exit failure if any test fails. main :: IO ()-main = hspec spec+main = hspec $ do+    describe "Path.Windows" Windows.spec+    describe "Path.Posix" Posix.spec
− test/Path/Gen.hs 
@@ -1,97 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Path.Gen where--import           Data.Functor-import           Prelude--import           Path-import           Path.Internal--import qualified System.FilePath as FilePath--import           Data.Maybe (mapMaybe)-import           Data.List (isInfixOf)-import           Data.Validity-import           Data.GenValidity--import           Test.QuickCheck---instance Validity (Path Abs File) where-  isValid p@(Path fp)-    =  FilePath.isAbsolute fp-    && not (FilePath.hasTrailingPathSeparator fp)-    && FilePath.isValid fp-    && not (hasParentDir fp)-    && (parseAbsFile fp == Just p)--instance Validity (Path Rel File) where-  isValid p@(Path fp)-    =  FilePath.isRelative fp-    && not (FilePath.hasTrailingPathSeparator fp)-    && FilePath.isValid fp-    && fp /= "."-    && not (hasParentDir fp)-    && (parseRelFile fp == Just p)--instance Validity (Path Abs Dir) where-  isValid p@(Path fp)-    =  FilePath.isAbsolute fp-    && FilePath.hasTrailingPathSeparator fp-    && FilePath.isValid fp-    && not (hasParentDir fp)-    && (parseAbsDir fp == Just p)--instance Validity (Path Rel Dir) where-  isValid p =-    FilePath.isRelative fp-    && FilePath.hasTrailingPathSeparator fp-    && FilePath.isValid fp-    && not (hasParentDir fp)-    && (parseRelDir fp == Just p)-    where fp = toFilePath p--instance GenUnchecked (Path Abs File) where-  genUnchecked = Path <$> genFilePath--instance GenValid (Path Abs File)--instance GenUnchecked (Path Rel File) where-  genUnchecked = Path <$> genFilePath--instance GenValid (Path Rel File)--instance GenUnchecked (Path Abs Dir) where-  genUnchecked = Path <$> genFilePath--instance GenValid (Path Abs Dir)--instance GenUnchecked (Path Rel Dir) where-  genUnchecked = Path <$> genFilePath--instance GenValid (Path Rel Dir)---- | 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, arbitrary), (1, elements "./\\")]--shrinkValidAbsFile :: Path Abs File -> [Path Abs File]-shrinkValidAbsFile = shrinkValidWith parseAbsFile--shrinkValidAbsDir :: Path Abs Dir -> [Path Abs Dir]-shrinkValidAbsDir = shrinkValidWith parseAbsDir--shrinkValidRelFile :: Path Rel File -> [Path Rel File]-shrinkValidRelFile = shrinkValidWith parseRelFile--shrinkValidRelDir :: Path Rel Dir -> [Path Rel Dir]-shrinkValidRelDir (Path []) = []-shrinkValidRelDir p = shrinkValidWith parseRelDir p--shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]-shrinkValidWith fun (Path s) = mapMaybe fun $ shrink s
test/Posix.hs view
@@ -7,15 +7,16 @@  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-import Path.Internal import Test.Hspec +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 spec =@@ -23,15 +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: filename" operationFilename-     describe "Operations: dirname" operationDirname-     describe "Operations: addFileExtension" operationAddFileExtension-     describe "Operations: setFileExtension" operationSetFileExtension+     Common.Posix.spec      describe "Restrictions" restrictions      describe "Aeson Instances" aesonInstances      describe "QuasiQuotes" quasiquotes@@ -52,173 +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 '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 ".") == "\"./\"")--operationAddFileExtension :: Spec-operationAddFileExtension = do-  it "adds extension if there is none" $-    addFileExtension "ext" $(mkAbsFile "/directory/path")-      `shouldReturn` $(mkAbsFile "/directory/path.ext")-  it "adds extension if there is already one" $-    addFileExtension "baz" $(mkRelFile "foo.bar")-      `shouldReturn` $(mkRelFile "foo.bar.baz")-  it "adds extension with dot" $-    addFileExtension ".bar" $(mkRelFile "foo")-      `shouldReturn` $(mkRelFile "foo.bar")-  it "adds extension with dot after dot" $-    $(mkRelFile "foo.") <.> ".bar"-      `shouldReturn` $(mkRelFile "foo..bar")-  it "adds extension without dot after dot" $-    $(mkRelFile "foo.") <.> "bar"-      `shouldReturn` $(mkRelFile "foo..bar")-  it "adds extension with separator" $  -- I'm not sure it's okay-    $(mkRelFile "foo") <.> "evil/extension"-      `shouldReturn` $(mkRelFile "foo.evil/extension")-  it "adds extension to file inside dotted directory" $-    $(mkRelFile "foo.bar/baz") <.> "txt"-      `shouldReturn` $(mkRelFile "foo.bar/baz.txt")-  it "throws InvalidRelFile extension if extenstion ends with /" $-    $(mkRelFile "foo") <.> "evil/"-      `shouldThrow` (== InvalidRelFile "foo.evil/")-  it "throws InvalidAbsFile extension if extenstion ends with /" $-    $(mkAbsFile "/home/cfg") <.> "txt/" -- No Eq instance for PathException-      `shouldThrow` (== InvalidAbsFile "/home/cfg.txt/")--operationSetFileExtension :: Spec-operationSetFileExtension = do-  it "adds extension if there is none" $-    setFileExtension "txt" $(mkRelFile "foo")-      `shouldReturn` $(mkRelFile "foo.txt")-  it "replaces extension if the input path already has one" $-    setFileExtension "txt" $(mkRelFile "foo.bar")-      `shouldReturn` $(mkRelFile "foo.txt")- -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =@@ -309,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,144 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | Test suite.--module Main where--import Control.Applicative-import Control.Monad-import Data.Aeson-import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Maybe-import Path-import Path.Internal-import Test.Hspec-import Test.QuickCheck-import Test.Validity.Property--import Path.Gen---- | Test suite entry point, returns exit failure if any test fails.-main :: IO ()-main = hspec spec---- | Test suite.-spec :: Spec-spec = parallel $ do-     describe "Parsing: Path Abs Dir" (parserSpec parseAbsDir)-     describe "Parsing: Path Rel Dir" (parserSpec parseRelDir)-     describe "Parsing: Path Abs File" (parserSpec parseAbsFile)-     describe "Parsing: Path Rel File" (parserSpec parseRelFile)-     describe "Operations: (</>)" operationAppend-     describe "Operations: stripProperPrefix" operationStripDir-     describe "Operations: isProperPrefixOf" operationIsParentOf-     describe "Operations: parent" operationParent-     describe "Operations: filename" operationFilename---- | The 'filename' operation.-operationFilename :: Spec-operationFilename = do-     it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $-         forAllShrink genValid shrinkValidAbsDir $ \parent ->-             forAllShrink genValid shrinkValidRelFile $ \file ->-                 filename (parent </> file) `shouldBe` filename file--     it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $-         forAllShrink genValid shrinkValidRelDir $ \parent ->-             forAllShrink genValid shrinkValidRelFile $ \file ->-                 filename (parent </> file) `shouldBe` filename file--     it "produces a valid path on when passed a valid absolute path" $ do-        producesValidsOnValids (filename :: Path Abs File -> Path Rel File)--     it "produces a valid path on when passed a valid relative path" $ do-        producesValidsOnValids (filename :: Path Rel File -> Path Rel File)---- | The 'parent' operation.-operationParent :: Spec-operationParent = do-     it "produces a valid path on when passed a valid file path" $ do-        producesValidsOnValids (parent :: Path Abs File -> Path Abs Dir)--     it "produces a valid path on when passed a valid directory path" $ do-        producesValidsOnValids (parent :: Path Abs Dir -> Path Abs Dir)---- | The 'isProperPrefixOf' operation.-operationIsParentOf :: Spec-operationIsParentOf = do-     it "isProperPrefixOf parent (parent </> child)" $-        forAllShrink genValid shrinkValidAbsDir $ \parent ->-            forAllShrink genValid shrinkValidRelFile $ \child ->-                isProperPrefixOf parent (parent </> child)--     it "isProperPrefixOf parent (parent </> child)" $-        forAllShrink genValid shrinkValidAbsDir $ \parent ->-            forAllShrink genValid shrinkValidRelDir $ \child ->-                child == Path [] || isProperPrefixOf parent (parent </> child)--     it "isProperPrefixOf parent (parent </> child)" $-        forAllShrink genValid shrinkValidRelDir $ \parent ->-            forAllShrink genValid shrinkValidRelFile $ \child ->-                isProperPrefixOf parent (parent </> child)--     it "isProperPrefixOf parent (parent </> child)" $-        forAllShrink genValid shrinkValidRelDir $ \parent ->-            forAllShrink genValid shrinkValidRelDir $ \child ->-                child == Path [] || isProperPrefixOf parent (parent </> child)---- | The 'stripProperPrefix' operation.-operationStripDir :: Spec-operationStripDir = do-     it "stripProperPrefix parent (parent </> child) = child" $-        forAllShrink genValid shrinkValidAbsDir $ \parent ->-            forAllShrink genValid shrinkValidRelFile $ \child ->-                stripProperPrefix parent (parent </> child) == Just child--     it "stripProperPrefix parent (parent </> child) = child" $-        forAllShrink genValid shrinkValidRelDir $ \parent ->-            forAllShrink genValid shrinkValidRelFile $ \child ->-                stripProperPrefix parent (parent </> child) == Just child--     it "stripProperPrefix parent (parent </> child) = child" $-        forAllShrink genValid shrinkValidAbsDir $ \parent ->-            forAllShrink genValid shrinkValidRelDir $ \child ->-                child == Path []-                || stripProperPrefix parent (parent </> child) == Just child--     it "stripProperPrefix parent (parent </> child) = child" $-        forAllShrink genValid shrinkValidRelDir $ \parent ->-            forAllShrink genValid shrinkValidRelDir $ \child ->-                child == Path []-                || stripProperPrefix parent (parent </> child) == Just child--     it "produces a valid path on when passed a valid absolute file paths" $ do-        producesValidsOnValids2 (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-        producesValidsOnValids2 (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-        producesValidsOnValids2 (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-        producesValidsOnValids2 (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-        producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)--     it "produces a valid path on when creating valid absolute directory paths" $ do-        producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)--     it "produces a valid path on when creating valid relative file paths" $ do-        producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File)--     it "produces a valid path on when creating valid relative directory paths" $ do-        producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)--parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec-parserSpec parser =-     it "Produces valid paths when it succeeds" $-       validIfSucceedsOnGen parser genFilePath
test/Windows.hs view
@@ -7,15 +7,16 @@  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-import Path.Internal import Test.Hspec +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 spec =@@ -23,15 +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: filename" operationFilename-     describe "Operations: dirname" operationDirname-     describe "Operations: addFileExtension" operationAddFileExtension-     describe "Operations: setFileExtension" operationSetFileExtension+     Common.Windows.spec      describe "Restrictions" restrictions      describe "Aeson Instances" aesonInstances      describe "QuasiQuotes" quasiquotes@@ -46,187 +39,25 @@      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) (unit test)"-    (dirname ($(mkAbsDir "C:\\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 $(mkRelDir .) == $(mkRelDir .)"-    (dirname $(mkRelDir ".") == $(mkRelDir "."))-  it-    "dirname C:\\ must be a Rel path"-    ((parseAbsDir $ show $ dirname (fromJust (parseAbsDir "C:\\"))-     :: 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 "C:\\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 "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 '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 "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 (unit test)"-        (stripProperPrefix $(mkAbsDir "C:\\\\\\bar\\")-                  ($(mkAbsDir "C:\\\\\\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 "C:\\home\\chris\\foo")-                  $(mkAbsDir "C:\\home\\chris\\foo") ==-         Nothing)---- | The '</>' operation.-operationAppend :: Spec-operationAppend =-  do it "AbsDir + RelDir = AbsDir"-        ($(mkAbsDir "C:\\home\\") </>-         $(mkRelDir "chris") ==-         $(mkAbsDir "C:\\home\\chris\\"))-     it "AbsDir + RelFile = AbsFile"-        ($(mkAbsDir "C:\\home\\") </>-         $(mkRelFile "chris\\test.txt") ==-         $(mkAbsFile "C:\\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 ".") == "\".\\\\\"")--operationAddFileExtension :: Spec-operationAddFileExtension = do-  it "adds extension if there is none" $-    addFileExtension "ext" $(mkAbsFile "C:\\directory\\path")-      `shouldReturn` $(mkAbsFile "C:\\directory\\path.ext")-  it "adds extension if there is already one" $-    addFileExtension "baz" $(mkRelFile "foo.bar")-      `shouldReturn` $(mkRelFile "foo.bar.baz")-  it "adds extension with dot" $-    addFileExtension ".bar" $(mkRelFile "foo")-      `shouldReturn` $(mkRelFile "foo.bar")-  it "adds extension with dot after dot" $-    $(mkRelFile "foo.") <.> ".bar"-      `shouldReturn` $(mkRelFile "foo..bar")-  it "adds extension without dot after dot" $-    $(mkRelFile "foo.") <.> "bar"-      `shouldReturn` $(mkRelFile "foo..bar")-  it "adds extension with separator" $  -- I'm not sure it's okay-    $(mkRelFile "foo") <.> "evil\\extension"-      `shouldReturn` $(mkRelFile "foo.evil\\extension")-  it "adds extension to file inside dotted directory" $-    $(mkRelFile "foo.bar\\baz") <.> "txt"-      `shouldReturn` $(mkRelFile "foo.bar\\baz.txt")-  it "throws InvalidRelFile extension if extenstion ends with \\" $-    $(mkRelFile "foo") <.> "evil\\"-      `shouldThrow` (== InvalidRelFile "foo.evil\\")-  it "throws InvalidAbsFile extension if extenstion ends with \\" $-    $(mkAbsFile "C:\\home\\cfg") <.> "txt\\"-      `shouldThrow` (== InvalidAbsFile "C:\\home\\cfg.txt\\")--operationSetFileExtension :: Spec-operationSetFileExtension = do-  it "adds extension if there is none" $-    setFileExtension "txt" $(mkRelFile "foo")-      `shouldReturn` $(mkRelFile "foo.txt")-  it "replaces extension if the input path already has one" $-    setFileExtension "txt" $(mkRelFile "foo.bar")-      `shouldReturn` $(mkRelFile "foo.txt")- -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =   do failing ""      failing ".\\"      failing "foo.txt"+     failing "C:"      succeeding "C:\\" (Path "C:\\")-     succeeding "C:\\\\" (Path "C:\\\\")-     -- succeeding "C:\\\\\\foo\\\\bar\\\\mu\\" (Path "C:\\foo\\bar\\mu\\") FIXME-     -- succeeding "C:\\\\\\foo\\\\bar\\\\mu" (Path "C:\\foo\\bar\\mu\\") FIXME-     -- succeeding "C:\\\\\\foo\\\\bar\\.\\\\mu" (Path "C:\\foo\\bar\\mu\\") FIXME+     succeeding "C:\\\\" (Path "C:\\")+     succeeding "C:\\\\\\foo\\\\bar\\\\mu\\" (Path "C:\\foo\\bar\\mu\\")+     succeeding "C:\\\\\\foo\\\\bar\\\\mu" (Path "C:\\foo\\bar\\mu\\")+     succeeding "C:\\\\\\foo\\\\bar\\.\\\\mu" (Path "C:\\foo\\bar\\mu\\")+     succeeding "\\\\unchost\\share" (Path "\\\\unchost\\share\\")+     succeeding "\\/unchost\\share" (Path "\\\\unchost\\share\\")+     succeeding "\\\\unchost\\share\\\\folder\\" (Path "\\\\unchost\\share\\folder\\")+     succeeding "\\\\?\\C:\\" (Path "\\\\?\\C:\\")+     succeeding "/\\?\\C:\\" (Path "\\\\?\\C:\\")+     succeeding "\\\\?\\C:\\\\\\folder\\\\" (Path "\\\\?\\C:\\folder\\")    where failing x = parserTest parseAbsDir x Nothing         succeeding x with = parserTest parseAbsDir x (Just with)@@ -235,16 +66,17 @@ parseRelDirSpec :: Spec parseRelDirSpec =   do failing ""-     -- failing "/" FIXME-     -- failing "//" FIXME-     -- succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19-     -- failing "\\" FIXME-     succeeding ".\\" (Path "")-     succeeding ".\\.\\" (Path "")+     failing "/"+     failing "//"+     failing "\\"      failing "\\\\"      failing "\\\\\\foo\\\\bar\\\\mu\\"      failing "\\\\\\foo\\\\bar\\\\\\\\mu"      failing "\\\\\\foo\\\\bar\\.\\\\mu"+     failing "\\\\unchost\\share"+     failing "\\\\?\\C:\\"+     succeeding ".\\" (Path "")+     succeeding ".\\.\\" (Path "")      succeeding "..." (Path "...\\")      succeeding "foo.bak" (Path "foo.bak\\")      succeeding ".\\foo" (Path "foo\\")@@ -269,10 +101,16 @@      failing "\\"      failing "\\\\"      failing "\\\\\\foo\\\\bar\\\\mu\\"-     -- succeeding "\\..." (Path "\\...") FIXME-     -- succeeding "\\foo.txt" (Path "\\foo.txt") FIXME-     -- succeeding "C:\\\\\\foo\\\\bar\\\\\\\\mu.txt" (Path "C:\\foo\\bar\\mu.txt") FIXME-     -- succeeding "C:\\\\\\foo\\\\bar\\.\\\\mu.txt" (Path "C:\\foo\\bar\\mu.txt") FIXME+     failing "\\..."+     failing "\\foo.txt"+     succeeding "C:\\\\\\foo\\\\bar\\\\\\\\mu.txt" (Path "C:\\foo\\bar\\mu.txt")+     succeeding "C:\\\\\\foo\\\\bar\\.\\\\mu.txt" (Path "C:\\foo\\bar\\mu.txt")+     succeeding "\\\\unchost\\share\\\\file.txt" (Path "\\\\unchost\\share\\file.txt")+     succeeding "\\/unchost\\share\\\\file.txt" (Path "\\\\unchost\\share\\file.txt")+     succeeding "\\\\unchost\\share\\.\\folder\\\\\\file.txt" (Path "\\\\unchost\\share\\folder\\file.txt")+     succeeding "\\\\?\\C:\\file.txt" (Path "\\\\?\\C:\\file.txt")+     succeeding "/\\?\\C:\\file.txt" (Path "\\\\?\\C:\\file.txt")+     succeeding "\\\\?\\C:\\\\\\folder\\.\\\\file.txt" (Path "\\\\?\\C:\\folder\\file.txt")    where failing x = parserTest parseAbsFile x Nothing         succeeding x with = parserTest parseAbsFile x (Just with)@@ -294,6 +132,8 @@      failing "\\\\\\foo\\\\bar\\\\mu\\"      failing "\\\\\\foo\\\\bar\\\\\\\\mu"      failing "\\\\\\foo\\\\bar\\.\\\\mu"+     failing "\\\\unchost\\share\\\\file.txt"+     failing "\\\\?\\C:\\file.txt"      succeeding "a.." (Path "a..")      succeeding "..." (Path "...")      succeeding "foo.txt" (Path "foo.txt")@@ -306,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