path 0.6.1 → 0.7.0

raw patch · 14 files changed

+1462/−938 lines, 14 filesdep +genvalidity-hspecdep +textdep ~basedep ~genvaliditydep ~genvalidity-property

Dependencies added: genvalidity-hspec, text

Dependency ranges changed: base, genvalidity, genvalidity-property, validity

Files

• CHANGELOG +39/−0
• LICENSE +1/−1
• README.md +3/−3
• path.cabal +40/−14
• src/Path.hs +8/−604
• src/Path/Include.hs +814/−0
• src/Path/Internal.hs +14/−2
• src/Path/Posix.hs +4/−0
• src/Path/Windows.hs +4/−0
• test/Common.hs +87/−0
• test/Path/Gen.hs +122/−55
• test/Posix.hs +4/−42
• test/ValidityTest.hs +170/−94
• test/Windows.hs +152/−123

@@ -1,3 +1,42 @@+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'.

@@ -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

@@ -92,7 +92,7 @@  ```haskell newtype Path b t = Path FilePath-  deriving (Typeable)+  deriving (Data, Typeable, Generic) ```  The type variables are:@@ -269,7 +269,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 +401,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)

@@ -1,29 +1,49 @@ name:                path-version:             0.6.1+version:             0.7.0 synopsis:            Support for well-typed paths description:         Support for well-typed paths. license:             BSD3 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+cabal-version:       1.18+tested-with:         GHC==8.2.2, GHC==8.4.4, GHC==8.6.5+extra-source-files:  README.md+                   , CHANGELOG+                   , src/Path/Include.hs +flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False+ library   hs-source-dirs:    src-  ghc-options:       -Wall -O2-  exposed-modules:   Path, Path.Internal+  exposed-modules:   Path+                   , Path.Internal+                   , Path.Posix+                   , Path.Windows   build-depends:     aeson-                   , base       >= 4.7     && < 5+                   , base       >= 4.10     && < 5                    , deepseq-                   , exceptions >= 0.4     && < 0.9+                   , exceptions >= 0.4     && < 0.11                    , filepath   < 1.2.0.1  || >= 1.3                    , hashable   >= 1.2     && < 1.3+                   , text                    , template-haskell+  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall+  if flag(dev)+    ghc-options:      -Wcompat+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wnoncanonical-monad-instances+                      -Wnoncanonical-monadfail-instances   default-language:  Haskell2010  test-suite test@@ -31,14 +51,19 @@   main-is:           Main.hs   other-modules:     Posix                    , Windows+                   , Common   hs-source-dirs:    test   build-depends:     aeson-                   , base       >= 4.7     && < 5+                   , base       >= 4.10     && < 5                    , bytestring                    , filepath   < 1.2.0.1  || >= 1.3                    , hspec      >= 2.0     && < 3                    , mtl        >= 2.0     && < 3                    , path+  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall   default-language:  Haskell2010  test-suite validity-test@@ -48,15 +73,16 @@   hs-source-dirs:    test   build-depends:     QuickCheck                    , aeson-                   , base       >= 4.7 && < 5+                   , base       >= 4.10 && < 5                    , bytestring                    , filepath   < 1.2.0.1  || >= 1.3-                   , genvalidity >= 0.3 && < 0.4-                   , genvalidity-property >= 0.0 && < 0.1+                   , genvalidity >= 0.8+                   , genvalidity-property >= 0.4+                   , genvalidity-hspec >= 0.7                    , hspec      >= 2.0     && < 3                    , mtl        >= 2.0     && < 3                    , path-                   , validity   >= 0.3.1.1 && < 0.4+                   , validity   >= 0.8.0.0   default-language:  Haskell2010   ghc-options: -threaded -rtsopts -with-rtsopts=-N 

@@ -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

@@ -0,0 +1,814 @@+-- This template expects CPP definitions for:+--     PLATFORM_NAME = Posix | Windows+--     IS_WINDOWS    = False | True++-- | This library provides a well-typed representation of paths in a filesystem+-- directory tree.+--+-- __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 TemplateHaskell #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleInstances #-}++module Path.PLATFORM_NAME+  (-- * 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+  ,addExtension+  ,splitExtension+  ,fileExtension+  ,replaceExtension+   -- * 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+  ,addFileExtension+  ,(<.>)+  ,setFileExtension+  ,(-<.>)+  )+  where++import           Control.Exception (Exception(..))+import           Control.Monad (liftM, when)+import           Control.Monad.Catch (MonadThrow(..))+import           Data.Aeson (FromJSON (..), FromJSONKey(..))+import qualified Data.Aeson.Types as Aeson+import           Data.Data+import qualified Data.Text as T+import           Data.List+import           Data.Maybe+import           Language.Haskell.TH+import           Language.Haskell.TH.Syntax (lift)+import           Language.Haskell.TH.Quote (QuasiQuoter(..))+import           Path.Internal+import qualified System.FilePath.PLATFORM_NAME 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 #-}++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+  | 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 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))++-- | '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+        | IS_WINDOWS = 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++-- | 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++-- | Normalizes seps only at the beginning of a path.+normalizeLeadingSeps :: FilePath -> FilePath+normalizeLeadingSeps path = normLeadingSep ++ rest+  where (leadingSeps, rest) = span FilePath.isPathSeparator path+        normLeadingSep = replicate (min 1 (length leadingSeps)) FilePath.pathSeparator++-- | Normalizes seps only at the end of a path.+normalizeTrailingSeps :: FilePath -> FilePath+normalizeTrailingSeps = reverse . normalizeLeadingSeps . reverse++-- | Applies platform-specific sep normalization following @FilePath.normalise@.+normalizeFilePath :: FilePath -> FilePath+normalizeFilePath+  | IS_WINDOWS = normalizeWindowsSeps . FilePath.normalise+  | otherwise  = normalizeLeadingSeps . FilePath.normalise++--------------------------------------------------------------------------------+-- 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

@@ -1,5 +1,7 @@ {-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TemplateHaskell    #-}  -- | Internal types and functions. @@ -12,10 +14,14 @@   where  import Control.DeepSeq (NFData (..))-import Data.Aeson (ToJSON (..))+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 Data.List+import Language.Haskell.TH.Syntax (Exp(..), Lift(..), Lit(..)) import qualified System.FilePath as FilePath  -- | Path of some base and type.@@ -33,7 +39,7 @@ -- 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)+  deriving (Data, Typeable, Generic)  -- | String equality. --@@ -83,6 +89,9 @@   {-# 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@@ -103,3 +112,6 @@         case FilePath.pathSeparator of             '/' -> filepath'             x   -> map (\y -> if x == y then '/' else y) filepath'++instance Lift (Path a b) where+  lift (Path str) = [|Path $(return (LitE (StringL str)))|]

@@ -0,0 +1,4 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME   Posix+#define IS_WINDOWS      False+#include "Include.hs"

@@ -0,0 +1,4 @@+{-# LANGUAGE CPP #-}+#define PLATFORM_NAME   Windows+#define IS_WINDOWS      True+#include "Include.hs"

@@ -0,0 +1,87 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Test functions that are common to Posix and Windows++module Common (extensionOperations) where++import Control.Monad+import Path+import System.FilePath (pathSeparator)+import Test.Hspec++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++extensionOperations :: String -> Spec+extensionOperations rootDrive = do+    let ext = ".foo"+    let extensions = ext : [".foo.", ".foo.."]++    -- Only filenames and extensions+    forM_ extensions (\x ->+        forM_ filenames $ \f -> do+            let Just file = parseRelFile f+            let Just fext = parseRelFile (f ++ x)+            (validExtensionsSpec x file fext))++    -- Relative dir paths+    forM_ dirnames (\d -> do+        forM_ filenames (\f -> do+            let f1 = d ++ [pathSeparator] ++ f+            let Just file = parseRelFile f1+            let Just fext = parseRelFile (f1 ++ ext)+            validExtensionsSpec ext file fext))++    -- Absolute dir paths+    forM_ dirnames (\d -> do+        forM_ filenames (\f -> do+            let f1 = rootDrive ++ d ++ [pathSeparator] ++ f+            let Just file = parseAbsFile f1+            let Just fext = parseAbsFile (f1 ++ ext)+            validExtensionsSpec ext file fext))++    -- Invalid extensions+    forM_ invalidExtensions $ \x -> do+        it ("throws InvalidExtension when extension is [" ++ x ++ "]")  $+            addExtension x $(mkRelFile "name")+            `shouldThrow` (== InvalidExtension x)++    where++    filenames =+        [ "name"+        , "name."+        , "name.."+        , ".name"+        , "..name"+        , "name.name"+        , "name..name"+        , "..."+        ]+    dirnames = filenames ++ ["."]+    invalidExtensions =+        [ ""+        , "."+        , "x"+        , ".."+        , "..."+        , "xy"+        , "foo"+        , "foo."+        , "foo.."+        , "..foo"+        , "...foo"+        , ".foo.bar"+        , ".foo" ++ [pathSeparator] ++ "bar"+        ]

@@ -1,76 +1,152 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TemplateHaskell #-}+ module Path.Gen where -import           Data.Functor-import           Prelude+import Data.Functor+import Prelude -import           Path-import           Path.Internal+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+import Data.GenValidity+import Data.List (isInfixOf, isSuffixOf)+import Data.Maybe (isJust, mapMaybe)+import Data.Validity +import Test.QuickCheck +-- | An absolute path to a file is valid if:+--+-- * Its path is an absolute path+-- * Its path has no trailing path separators+-- * Its path is valid according to 'System.FilePath's definition.+-- * Its path does not end in '/.'+-- * Its path is not '.'+-- * Its path does not contain '..'.+-- * Parsing the path and rendering it again results in the same path. 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)+  validate p@(Path fp) =+    mconcat+      [ declare "The path is absolute." $ FilePath.isAbsolute fp+      , declare "The path has no trailing path separator." $+        not (FilePath.hasTrailingPathSeparator fp)+      , declare "System.FilePath considers the path valid." $ FilePath.isValid fp+      , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)+      , declare "The path does not equal \".\"" $ fp /= "."+      , declare "The path does not a parent directory." $ not (hasParentDir fp)+      , declare "The path can be identically parsed as an absolute file path." $+        parseAbsFile fp == Just p+      ] +-- | A relative path to a file is valid if:+--+-- * Its path is a relative path+-- * Its path does not have a trailing path separator+-- * Its path is valid according to 'System.FilePath's definition.+-- * Its path is not '.'+-- * Its path is not empty+-- * Its path does not end in '/.'+-- * Its path is not '.'+-- * Its path does not contain '..'.+-- * Parsing the path and rendering it again results in the same path. 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)+  validate p@(Path fp) =+    mconcat+      [ declare "The path is relative." $ FilePath.isRelative fp+      , declare "The path has no trailing path separator." $+        not (FilePath.hasTrailingPathSeparator fp)+      , declare "System.FilePath considers the path valid." $ FilePath.isValid fp+      , declare "The path does not equal \".\"" $ fp /= "."+      , declare "The path is not empty" $ not (null fp)+      , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)+      , declare "The path does not a parent directory." $ not (hasParentDir fp)+      , declare "The path can be identically parsed as a relative file path." $+        parseRelFile fp == Just p+      ] +-- | An absolute path to a directory is valid if:+--+-- * Its path is an absolute path+-- * Its path has a trailing path separator+-- * Its path is valid according to 'System.FilePath's definition.+-- * Its path does not contain '..'.+-- * Parsing the path and rendering it again results in the same path. 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)+  validate p@(Path fp) =+    mconcat+      [ declare "The path is absolute." $ FilePath.isAbsolute fp+      , declare "The path has a trailing path separator." $ FilePath.hasTrailingPathSeparator fp+      , declare "System.FilePath considers the path valid." $ FilePath.isValid fp+      , declare "The path does not a parent directory." $ not (hasParentDir fp)+      , declare "The path can be identically parsed as an absolute directory path." $+        parseAbsDir fp == Just p+      ] +-- | A relative path to a directory is valid if:+--+-- * Its path is a relative path+-- * Its path has a trailing path separator+-- * Its path is valid according to 'System.FilePath's definition.+-- * Its path does not contain '..'.+-- * Parsing the path and rendering it again results in the same path. 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+  validate (Path "") = valid+  validate p@(Path fp) =+    mconcat+      [ declare "The path is relative." $ FilePath.isRelative fp+      , declare "The path has a trailing path separator." $ FilePath.hasTrailingPathSeparator fp+      , declare "System.FilePath considers the path valid." $ FilePath.isValid fp+      , declare "The path is not empty." $ not (null fp)+      , declare "The path does not a parent directory." $ not (hasParentDir fp)+      , declare "The path can be identically parsed as a relative directory path." $+        parseRelDir fp == Just p+      ]  instance GenUnchecked (Path Abs File) where   genUnchecked = Path <$> genFilePath -instance GenValid (Path Abs File)+instance GenValid (Path Abs File) where+  shrinkValid = shrinkValidWith parseAbsFile  instance GenUnchecked (Path Rel File) where   genUnchecked = Path <$> genFilePath -instance GenValid (Path Rel File)+instance GenValid (Path Rel File) where+  shrinkValid = shrinkValidWith parseRelFile  instance GenUnchecked (Path Abs Dir) where   genUnchecked = Path <$> genFilePath -instance GenValid (Path Abs Dir)+instance GenValid (Path Abs Dir) where+  shrinkValid = shrinkValidWith parseAbsDir  instance GenUnchecked (Path Rel Dir) where   genUnchecked = Path <$> genFilePath -instance GenValid (Path Rel Dir)+instance GenValid (Path Rel Dir) where+  shrinkValid = shrinkValidWith parseRelDir +data Extension =+  Extension String+  deriving (Show)++instance Validity Extension where+  validate (Extension ext) =+    mconcat+      [ delve "Extension" ext+      , declare "It is possible to add the extension to \"./\"" $+        isJust $ addExtension ext $(mkRelFile "x")+      ]++instance GenUnchecked Extension where+  genUnchecked = Extension <$> genFilePath+  shrinkUnchecked (Extension e) = Extension <$> shrinkUnchecked e++instance GenValid Extension+ -- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and -- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to -- be valid.@@ -78,20 +154,11 @@ 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+genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")]  shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]-shrinkValidWith fun (Path s) = mapMaybe fun $ shrink s+shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkUnchecked f++shrinkValidExtension :: Extension -> [Extension]+shrinkValidExtension (Extension s) =+  map (Extension . drop 1 . toFilePath) $ mapMaybe (flip addExtension $(mkRelFile "x")) (shrink s)

@@ -12,10 +12,12 @@ import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Maybe-import Path+import Path.Posix import Path.Internal import Test.Hspec +import Common (extensionOperations)+ -- | Test suite (Posix version). spec :: Spec spec =@@ -30,8 +32,7 @@      describe "Operations: parent" operationParent      describe "Operations: filename" operationFilename      describe "Operations: dirname" operationDirname-     describe "Operations: addFileExtension" operationAddFileExtension-     describe "Operations: setFileExtension" operationSetFileExtension+     describe "Operations: extensions" (extensionOperations "/")      describe "Restrictions" restrictions      describe "Aeson Instances" aesonInstances      describe "QuasiQuotes" quasiquotes@@ -179,45 +180,6 @@         (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

@@ -1,8 +1,9 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}  -- | Test suite.- module Main where  import Control.Applicative@@ -13,8 +14,9 @@ import Path import Path.Internal import Test.Hspec+import Test.Hspec.QuickCheck import Test.QuickCheck-import Test.Validity.Property+import Test.Validity  import Path.Gen @@ -24,121 +26,195 @@  -- | 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+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)+    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 "Operations" $ do+      describe "(</>)" operationAppend+      describe "stripProperPrefix" operationStripDir+      describe "isProperPrefixOf" operationIsParentOf+      describe "parent" operationParent+      describe "filename" operationFilename+      describe "dirname" operationDirname+    describe "Extensions" extensionsSpec  -- | 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)+  forAllDirs "filename parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \parent ->+    forAllValid $ \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) -     it "produces a valid path on when passed a valid relative path" $ do-        producesValidsOnValids (filename :: Path Rel 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+  it "produces a valid path on when passed a valid absolute path" $ do+    producesValidsOnValids (dirname :: Path Abs Dir -> Path Rel Dir)+  it "produces a valid path on when passed a valid relative path" $ do+    producesValidsOnValids (dirname :: Path Rel Dir -> Path Rel Dir)  -- | 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)+  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)+  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-     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))+  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+    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 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) -     it "produces a valid path on when creating valid absolute directory paths" $ do-        producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)+extensionsSpec :: Spec+extensionsSpec = do+  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+    "(toFilePath . fromJust . addExtension ext) file \+        \== toFilePath a ++ b" $ \file ->+    forAllValid $ \(Extension ext) ->+      (toFilePath . fromJust . addExtension ext) file `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 "uncurry addExtension . swap >=> splitExtension == return" $ \file ->+    forAllValid $ \(Extension ext) ->+      (addExtension ext file >>= splitExtension) `shouldReturn` (file, ext)+  forAllFiles "fileExtension == (fmap snd) . splitExtension" $ \file ->+    case splitExtension file of+      Nothing -> pure ()+      Just (_, ext) -> fileExtension file `shouldBe` Just ext+  forAllFiles "flip addExtension file >=> fileExtension == return" $ \file ->+    forAllValid $ \(Extension ext) ->+      (fileExtension . fromJust . addExtension ext) file `shouldReturn` ext+  forAllFiles "(fileExtension >=> flip replaceExtension file) file == return file" $ \file ->+    case fileExtension file of+      Nothing -> pure ()+      Just ext -> replaceExtension ext file `shouldBe` Just file+  where+    addExtGensValidFile p =+      case addExtension p $(mkRelFile "x") of+        Nothing -> True+        Just x ->+          case parseRelFile p of+            Nothing -> False+            _ -> True -     it "produces a valid path on when creating valid relative file paths" $ do-        producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel 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 -     it "produces a valid path on when creating valid relative directory paths" $ do-        producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)+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 +forAllParentsAndChildren ::+     Testable a => String -> (forall b t. Path b Dir -> Path Rel t -> a) -> Spec+forAllParentsAndChildren n func = do+  it (unwords [n, "Path Abs Dir", "Path Rel Dir"]) $+    forAllValid $ \(parent :: Path Abs Dir) ->+      forAllValid $ \(child :: Path Rel Dir) -> func parent child+  it (unwords [n, "Path Rel Dir", "Path Rel Dir"]) $+    forAllValid $ \(parent :: Path Rel Dir) ->+      forAllValid $ \(child :: Path Rel Dir) -> func parent child+  it (unwords [n, "Path Abs Dir", "Path Rel File"]) $+    forAllValid $ \(parent :: Path Abs Dir) ->+      forAllValid $ \(child :: Path Rel File) -> func parent child+  it (unwords [n, "Path Rel Dir", "Path Rel File"]) $+    forAllValid $ \(parent :: Path Rel Dir) ->+      forAllValid $ \(child :: Path Rel File) -> func parent child++forAllPaths :: Testable a => String -> (forall b t. Path b t -> a) -> Spec+forAllPaths n func = do+  it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(path :: Path Abs Dir) -> func path+  it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(path :: Path Rel Dir) -> func path+  it (unwords [n, "Path Abs File"]) $ forAllValid $ \(path :: Path Abs File) -> func path+  it (unwords [n, "Path Rel File"]) $ forAllValid $ \(path :: Path Rel File) -> func path+ parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec parserSpec parser =-     it "Produces valid paths when it succeeds" $-       validIfSucceedsOnGen parser genFilePath+  it "Produces valid paths when it succeeds" $+  forAllShrink genFilePath shrinkUnchecked $ \path ->+    case parser path of+      Nothing -> pure ()+      Just p ->+        case prettyValidate p of+          Left err -> expectationFailure err+          Right _ -> pure ()

@@ -11,11 +11,14 @@ import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Function (on) import Data.Maybe-import Path+import Path.Windows import Path.Internal import Test.Hspec +import Common (extensionOperations)+ -- | Test suite (Windows version). spec :: Spec spec =@@ -30,8 +33,7 @@      describe "Operations: parent" operationParent      describe "Operations: filename" operationFilename      describe "Operations: dirname" operationDirname-     describe "Operations: addFileExtension" operationAddFileExtension-     describe "Operations: setFileExtension" operationSetFileExtension+     describe "Operations: extensions" (extensionOperations "C:\\")      describe "Restrictions" restrictions      describe "Aeson Instances" aesonInstances      describe "QuasiQuotes" quasiquotes@@ -57,43 +59,57 @@  -- | 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)+operationDirname =+  do it "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (absolute)"+        (dirnamesShouldBeEqual+          ($(mkAbsDir "C:\\chris\\") </> $(mkRelDir "bar"))+          $(mkRelDir "bar"))+     it "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (relative)"+        (dirnamesShouldBeEqual+          ($(mkRelDir "home\\chris\\") </> $(mkRelDir "bar"))+          $(mkRelDir "bar"))+     it "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (UNC)"+        (dirnamesShouldBeEqual+          ($(mkAbsDir "\\\\home\\chris\\") </> $(mkRelDir "bar"))+          $(mkRelDir "bar"))+     it "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (Unicode)"+        (dirnamesShouldBeEqual+          ($(mkAbsDir "\\\\?\\C:\\home\\chris\\") </> $(mkRelDir "bar"))+          $(mkRelDir "bar"))+     it "dirname $(mkRelDir .) == $(mkRelDir .)"+        (dirnamesShouldBeEqual+          $(mkRelDir ".")+          $(mkRelDir "."))+     it "dirname C:\\ must be a Rel path"+        ((parseAbsDir $ show $ dirname (fromJust (parseAbsDir "C:\\")) :: Maybe (Path Abs Dir)) == Nothing)+  where dirnamesShouldBeEqual = (==) `on` dirname  -- | 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"))+  do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (absolute)"+        (filenamesShouldBeEqual+          ($(mkAbsDir "C:\\chris\\") </> $(mkRelFile "bar.txt"))+          $(mkRelFile "bar.txt"))+     it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (relative)"+        (filenamesShouldBeEqual+          ($(mkRelDir "home\\chris\\") </> $(mkRelFile "bar.txt"))+          $(mkRelFile "bar.txt"))+     it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (UNC)"+        (filenamesShouldBeEqual+          ($(mkAbsDir "\\\\host\\share\\chris\\") </> $(mkRelFile "bar.txt"))+          $(mkRelFile "bar.txt"))+     it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (Unicode)"+        (filenamesShouldBeEqual+          ($(mkAbsDir "\\\\?\\C:\\home\\chris\\") </> $(mkRelFile "bar.txt"))+          $(mkRelFile "bar.txt"))+  where filenamesShouldBeEqual = (==) `on` filename  -- | The 'parent' operation. operationParent :: Spec operationParent =   do it "parent (parent </> child) == parent"-        (parent ($(mkAbsDir "C:\\foo") </>-                    $(mkRelDir "bar")) ==-         $(mkAbsDir "C:\\foo"))+        (parent ($(mkAbsDir "C:\\foo") </> $(mkRelDir "bar")) == $(mkAbsDir "C:\\foo"))      it "parent \"C:\\\" == \"C:\\\""         (parent $(mkAbsDir "C:\\") == $(mkAbsDir "C:\\"))      it "parent \"C:\\x\" == \"C:\\\""@@ -108,67 +124,103 @@ operationIsProperPrefixOf =   do it "isProperPrefixOf parent (parent </> child) (absolute)"         (isProperPrefixOf-           $(mkAbsDir "C:\\\\\\bar\\")-           ($(mkAbsDir "C:\\\\\\bar\\") </>-            $(mkRelFile "bar\\foo.txt")))-+          $(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")))-+          $(mkRelDir "bar\\")+          ($(mkRelDir "bar\\") </> $(mkRelFile "bob\\foo.txt")))+     it "isProperPrefixOf parent (parent </> child) (UNC)"+        (isProperPrefixOf+          $(mkAbsDir "\\\\host\\share\\")+          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelFile "bob\\foo.txt")))+     it "isProperPrefixOf parent (parent </> child) (Unicode)"+        (isProperPrefixOf+          $(mkAbsDir "\\\\?\\C:\\folder\\")+          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelFile "bob\\foo.txt")))      it "not (x `isProperPrefixOf` x)"         (not (isProperPrefixOf $(mkRelDir "x") $(mkRelDir "x")))-      it "not (\\ `isProperPrefixOf` \\)"         (not (isProperPrefixOf $(mkAbsDir "C:\\") $(mkAbsDir "C:\\")))  -- | The 'stripProperPrefix' operation. operationStripProperPrefix :: Spec operationStripProperPrefix =-  do it "stripProperPrefix parent (parent </> child) = child (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"))-+  do it "stripProperPrefix parent (parent </> child) = child (absolute)"+        (remainingPathShouldBe+          $(mkAbsDir "C:\\\\\\bar\\")+          ($(mkAbsDir "C:\\\\\\bar\\") </> $(mkRelFile "bar\\foo.txt"))+          (Just $(mkRelFile "bar\\foo.txt")))+     it "stripProperPrefix parent (parent </> child) = child (relative)"+        (remainingPathShouldBe+          $(mkRelDir "bar\\")+          ($(mkRelDir "bar\\") </> $(mkRelFile "bob\\foo.txt"))+          (Just $(mkRelFile "bob\\foo.txt")))+     it "stripProperPrefix parent (parent </> child) = child (UNC)"+        (remainingPathShouldBe+          $(mkAbsDir "\\\\host\\share\\")+          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelFile "bob\\foo.txt"))+          (Just $(mkRelFile "bob\\foo.txt")))+     it "stripProperPrefix parent (parent </> child) = child (Unicode)"+        (remainingPathShouldBe+          $(mkAbsDir "\\\\?\\C:\\folder\\")+          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelFile "bob\\foo.txt"))+          (Just $(mkRelFile "bob\\foo.txt")))      it "stripProperPrefix parent parent = _|_"-        (stripProperPrefix $(mkAbsDir "C:\\home\\chris\\foo")-                  $(mkAbsDir "C:\\home\\chris\\foo") ==-         Nothing)+        (remainingPathShouldBe+          $(mkAbsDir "C:\\home\\chris\\foo")+          $(mkAbsDir "C:\\home\\chris\\foo")+          Nothing)+  where remainingPathShouldBe prefix path suffix =+          stripProperPrefix prefix path == suffix  -- | The '</>' operation. operationAppend :: Spec operationAppend =   do it "AbsDir + RelDir = AbsDir"-        ($(mkAbsDir "C:\\home\\") </>-         $(mkRelDir "chris") ==-         $(mkAbsDir "C:\\home\\chris\\"))+        (shouldBe+          ($(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"))+        (shouldBe+          ($(mkAbsDir "C:\\home\\") </> $(mkRelFile "chris\\test.txt"))+          $(mkAbsFile "C:\\home\\chris\\test.txt"))      it "RelDir + RelDir = RelDir"-        ($(mkRelDir "home\\") </>-         $(mkRelDir "chris") ==-         $(mkRelDir "home\\chris"))+        (shouldBe+          ($(mkRelDir "home\\") </> $(mkRelDir "chris"))+          $(mkRelDir "home\\chris"))      it ". + . = ."-        ($(mkRelDir ".\\") </> $(mkRelDir ".") == $(mkRelDir "."))+        (shouldBe+          ($(mkRelDir ".\\") </> $(mkRelDir "."))+          $(mkRelDir "."))      it ". + x = x"-        ($(mkRelDir ".") </> $(mkRelDir "x") == $(mkRelDir "x"))+        (shouldBe+          ($(mkRelDir ".") </> $(mkRelDir "x"))+          $(mkRelDir "x"))      it "x + . = x"-        ($(mkRelDir "x") </> $(mkRelDir ".\\") == $(mkRelDir "x"))+        (shouldBe+          ($(mkRelDir "x") </> $(mkRelDir ".\\"))+          $(mkRelDir "x"))      it "RelDir + RelFile = RelFile"-        ($(mkRelDir "home\\") </>-         $(mkRelFile "chris\\test.txt") ==-         $(mkRelFile "home\\chris\\test.txt"))+        (shouldBe+          ($(mkRelDir "home\\") </> $(mkRelFile "chris\\test.txt"))+          $(mkRelFile "home\\chris\\test.txt"))+     it "AbsDir(UNC) + RelDir = AbsDir(UNC)"+        (shouldBe+          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelDir "folder\\"))+          $(mkAbsDir "\\\\host\\share\\folder\\"))+     it "AbsDir(UNC) + RelFile = AbsFile(UNC)"+        (shouldBe+          ($(mkAbsDir "\\\\host\\share\\") </> $(mkRelFile "folder\\file.txt"))+          $(mkAbsFile "\\\\host\\share\\folder\\file.txt"))+     it "AbsDir(Unicode) + RelDir = AbsDir(Unicode)"+        (shouldBe+          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelDir "another\\"))+          $(mkAbsDir "\\\\?\\C:\\folder\\another\\"))+     it "AbsDir(Unicode) + RelFile = AbsFile(Unicode)"+        (shouldBe+          ($(mkAbsDir "\\\\?\\C:\\folder\\") </> $(mkRelFile "file.txt"))+          $(mkAbsFile "\\\\?\\C:\\folder\\file.txt"))  operationToFilePath :: Spec operationToFilePath =@@ -177,56 +229,24 @@      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 +255,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 +290,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 +321,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")