Bump to 0.5.3

Various improvements

.gitignore

@@ -7,3 +7,4 @@ cabal-dev/
 TAGS
 tags
 *.tag
+.stack-work/

CHANGELOG

@@ -1,4 +1,20 @@
+0.5.3:
+	* Added conversion functions.
+
 0.2.0:
 
         * Rename parentAbs to simply parent.
 	* Add dirname.
+
+0.3.0:
+	* Removed Generic instance.
+
+0.4.0:
+	* Implemented stricter parsing, disabling use of "..".
+	* Made stripDir generic over MonadThrow
+
+0.5.0:
+	* Fix stripDir p p /= Nothing bug.
+
+0.5.2:
+	* Removed unused DeriveGeneric.

path.cabal

@@ -1,5 +1,5 @@
 name:                path
-version:             0.2.0
+version:             0.5.3
 synopsis:            Path
 description:         Path
 license:             BSD3
@@ -10,6 +10,7 @@ copyright:           2015 FP Complete
 category:            Filesystem
 build-type:          Simple
 cabal-version:       >=1.8
+extra-source-files:  README.md, CHANGELOG
 
 library
   hs-source-dirs:    src/
@@ -29,3 +30,7 @@ test-suite test
                  , hspec
                  , mtl
                  , path
+
+source-repository head
+    type:     git
+    location: https://github.com/chrisdone/path.git

src/Path.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE EmptyDataDecls #-}
 
@@ -32,6 +31,10 @@ module Path
   ,dirname
   -- * Conversion
   ,toFilePath
+  ,fromAbsDir
+  ,fromRelDir
+  ,fromAbsFile
+  ,fromRelFile
   )
   where
 
@@ -65,6 +68,7 @@ data PathParseException
   | InvalidRelDir FilePath
   | InvalidAbsFile FilePath
   | InvalidRelFile FilePath
+  | Couldn'tStripPrefixDir FilePath FilePath
   deriving (Show,Typeable)
 instance Exception PathParseException
 
@@ -81,7 +85,8 @@ parseAbsDir :: MonadThrow m
 parseAbsDir filepath =
   if FilePath.isAbsolute filepath &&
      not (null (normalizeDir filepath)) &&
-     not (isPrefixOf "~/" filepath)
+     not ("~/" `isPrefixOf` filepath) &&
+     not (hasParentDir filepath)
      then return (Path (normalizeDir filepath))
      else throwM (InvalidAbsDir filepath)
 
@@ -95,8 +100,10 @@ parseRelDir :: MonadThrow m
 parseRelDir filepath =
   if not (FilePath.isAbsolute filepath) &&
      not (null filepath) &&
-     not (isPrefixOf "~/" filepath) &&
-     not (null (normalizeDir filepath))
+     not ("~/" `isPrefixOf` filepath) &&
+     not (hasParentDir filepath) &&
+     not (null (normalizeDir filepath)) &&
+     filepath /= ".."
      then return (Path (normalizeDir filepath))
      else throwM (InvalidRelDir filepath)
 
@@ -109,8 +116,10 @@ parseAbsFile :: MonadThrow m
 parseAbsFile filepath =
   if FilePath.isAbsolute filepath &&
      not (FilePath.hasTrailingPathSeparator filepath) &&
-     not (isPrefixOf "~/" filepath) &&
-     not (null (normalizeFile filepath))
+     not ("~/" `isPrefixOf` filepath) &&
+     not (hasParentDir filepath) &&
+     not (null (normalizeFile filepath)) &&
+     filepath /= ".."
      then return (Path (normalizeFile filepath))
      else throwM (InvalidAbsFile filepath)
 
@@ -121,13 +130,29 @@ parseAbsFile filepath =
 parseRelFile :: MonadThrow m
              => FilePath -> m (Path Rel File)
 parseRelFile filepath =
-  if not (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&
+  if not (FilePath.isAbsolute filepath ||
+          FilePath.hasTrailingPathSeparator filepath) &&
      not (null filepath) &&
-     not (isPrefixOf "~/" filepath) &&
-     not (null (normalizeFile filepath))
+     not ("~/" `isPrefixOf` filepath) &&
+     not (hasParentDir filepath) &&
+     not (null (normalizeFile filepath)) &&
+     filepath /= ".."
      then return (Path (normalizeFile filepath))
      else throwM (InvalidRelFile filepath)
 
+-- | Helper function: check if the filepath has any parent directories in it.
+-- This handles the logic of checking for different path separators on Windows.
+hasParentDir :: FilePath -> Bool
+hasParentDir filepath' =
+     ("/.." `isSuffixOf` filepath) ||
+     ("/../" `isInfixOf` filepath) ||
+     ("../" `isPrefixOf` filepath)
+  where
+    filepath =
+        case FilePath.pathSeparator of
+            '/' -> filepath'
+            x   -> map (\y -> if x == y then '/' else y) filepath'
+
 --------------------------------------------------------------------------------
 -- Constructors
 
@@ -175,9 +200,29 @@ mkRelFile s =
 -- Conversion
 
 -- | Convert to a 'FilePath' type.
+--
+-- All directories have a trailing slash, so if you want no trailing
+-- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from
+-- the filepath package.
 toFilePath :: Path b t -> FilePath
 toFilePath (Path l) = l
 
+-- | 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
+
 --------------------------------------------------------------------------------
 -- Operations
 
@@ -211,19 +256,25 @@ toFilePath (Path l) = l
 --
 -- The following properties hold:
 --
--- @stripDir parent (parent \<\/> child) = child@
+-- @stripDir x (x \<\/> y) = y@
 --
 -- Cases which are proven not possible:
 --
 -- @stripDir (a :: Path Abs …) (b :: Path Rel …)@
 --
--- @stripDir (a :: Path Rel) (b :: Path Abs …)@
+-- @stripDir (a :: Path Rel …) (b :: Path Abs …)@
 --
 -- In other words the bases must match.
 --
-stripDir :: Path b Dir -> Path b t -> Maybe (Path Rel t)
+-- Throws: 'Couldn'tStripPrefixDir'
+--
+stripDir :: MonadThrow m
+         => Path b Dir -> Path b t -> m (Path Rel t)
 stripDir (Path p) (Path l) =
-  fmap Path (stripPrefix p l)
+  case stripPrefix p l of
+    Nothing -> throwM (Couldn'tStripPrefixDir p l)
+    Just "" -> throwM (Couldn'tStripPrefixDir p l)
+    Just ok -> return (Path ok)
 
 -- | Is p a parent of the given location? Implemented in terms of
 -- 'stripDir'. The bases must match.
@@ -235,7 +286,7 @@ isParentOf p l =
 --
 -- The following properties hold:
 --
--- @parent (parent \<\/> child) == parent@
+-- @parent (x \<\/> y) == x@
 --
 -- On the root, getting the parent is idempotent:
 --
@@ -249,7 +300,7 @@ parent (Path fp) =
 --
 -- The following properties hold:
 --
--- @filename (parent \<\/> filename a) == a@
+-- @filename (p \<\/> a) == filename a@
 --
 filename :: Path b File -> Path Rel File
 filename (Path l) =
@@ -259,7 +310,7 @@ filename (Path l) =
 --
 -- The following properties hold:
 --
--- @dirname (parent \<\/> dirname a) == a@
+-- @dirname (p \<\/> a) == dirname a@
 --
 dirname :: Path b Dir -> Path Rel Dir
 dirname (Path l) =

src/Path/Internal.hs

@@ -1,7 +1,4 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 -- | Internal types and functions.
 
@@ -10,7 +7,6 @@ module Path.Internal
   where
 
 import Data.Data
-import GHC.Generics
 
 -- | Path of some base and type.
 --
@@ -22,7 +18,7 @@ import GHC.Generics
 -- 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,Generic)
+  deriving (Typeable)
 
 -- | String equality.
 --

test/Main.hs

@@ -4,6 +4,9 @@
 
 module Main where
 
+import Control.Applicative
+import Control.Monad
+import Data.Maybe
 import Data.Monoid
 import Path
 import Path.Internal
@@ -23,8 +26,27 @@ spec =
      describe "Operations: (</>)" operationAppend
      describe "Operations: stripDir" operationStripDir
      describe "Operations: isParentOf" operationIsParentOf
-     describe "Operations: parentAbs" operationParentAbs
+     describe "Operations: parent" operationParent
      describe "Operations: filename" operationFilename
+     describe "Restrictions" restrictions
+
+-- | Restricting the input of any tricks.
+restrictions :: Spec
+restrictions =
+  do parseFails "~/"
+     parseFails "~/foo"
+     parseFails "~/foo/bar"
+     parseFails "../"
+     parseFails ".."
+     parseFails "/.."
+     parseFails "/foo/../bar/"
+     parseFails "/foo/bar/.."
+  where parseFails x =
+          it (show x ++ " should be rejected")
+             (isNothing (void (parseAbsDir x) <|>
+                         void (parseRelDir x) <|>
+                         void (parseAbsFile x) <|>
+                         void (parseRelFile x)))
 
 -- | The 'filename' operation.
 operationFilename :: Spec
@@ -38,10 +60,10 @@ operationFilename =
                    filename $(mkRelFile "bar.txt")) ==
          $(mkRelFile "bar.txt"))
 
--- | The 'parentAbs' operation.
-operationParentAbs :: Spec
-operationParentAbs =
-  do it "parentAbs (parent </> child) == parent"
+-- | The 'parent' operation.
+operationParent :: Spec
+operationParent =
+  do it "parent (parent </> child) == parent"
         (parent ($(mkAbsDir "/foo") </>
                     $(mkRelDir "bar")) ==
          $(mkAbsDir "/foo"))
@@ -79,6 +101,10 @@ operationStripDir =
                   ($(mkRelDir "bar/") </>
                    $(mkRelFile "bob/foo.txt")) ==
          Just $(mkRelFile "bob/foo.txt"))
+     it "stripDir parent parent = _|_"
+        (stripDir $(mkAbsDir "/home/chris/foo")
+                  $(mkAbsDir "/home/chris/foo") ==
+         Nothing)
 
 -- | The '</>' operation.
 operationAppend :: Spec