Fix #190 Add splitDrive, takeDrive, dropDrive and isDrive

CHANGELOG

@@ -1,3 +1,6 @@
+0.9.3
+  * Add `splitDrive`, `takeDrive`, `dropDrive` and `isDrive`.
+
 0.9.2
   * Data instances for Rel, Abs, File, and Dir.
   * Bump hashable upper bound to <1.5.

path.cabal

@@ -1,5 +1,5 @@
 name:                path
-version:             0.9.2
+version:             0.9.3
 synopsis:            Support for well-typed paths
 description:         Support for well-typed paths.
 license:             BSD3

src/Path/Include.hs

@@ -63,6 +63,10 @@ module Path.PLATFORM_NAME
   ,splitExtension
   ,fileExtension
   ,replaceExtension
+  ,splitDrive
+  ,takeDrive
+  ,dropDrive
+  ,isDrive
   ,mapSomeBase
   ,prjSomeBase
    -- * Parsing
@@ -377,6 +381,31 @@ parent (Path fp) =
     $ FilePath.takeDirectory
     $ FilePath.dropTrailingPathSeparator fp
 
+-- | Split an absolute path into a drive and, perhaps, a path. On POSIX, @/@ is
+-- a drive.
+splitDrive :: Path Abs t -> (Path Abs Dir, Maybe (Path Rel t))
+splitDrive (Path fp) =
+    let (d, rest) = FilePath.splitDrive fp
+        mRest = if null rest then Nothing else Just (Path rest)
+    in  (Path d, mRest)
+
+-- | Get the drive from an absolute path. On POSIX, @/@ is a drive.
+--
+-- > takeDrive x = fst (splitDrive x)
+takeDrive :: Path Abs t -> Path Abs Dir
+takeDrive = fst . splitDrive
+
+-- | Drop the drive from an absolute path. May result in 'Nothing' if the path
+-- is just a drive.
+--
+-- > dropDrive x = snd (splitDrive x)
+dropDrive :: Path Abs t -> Maybe (Path Rel t)
+dropDrive = snd . splitDrive
+
+-- | Is an absolute directory path a drive?
+isDrive :: Path Abs Dir -> Bool
+isDrive = isNothing . dropDrive
+
 -- | Extract the file part of a path.
 --
 -- The following properties hold:

test/Posix.hs

@@ -30,6 +30,8 @@ spec =
      describe "Operations: stripProperPrefix" operationStripProperPrefix
      describe "Operations: isProperPrefixOf" operationIsProperPrefixOf
      describe "Operations: parent" operationParent
+     describe "Operations: splitDrive" operationSplitDrive
+     describe "Operations: isDrive" operationIsDrive
      describe "Operations: filename" operationFilename
      describe "Operations: dirname" operationDirname
      describe "Operations: extensions" (extensionOperations "/")
@@ -107,6 +109,24 @@ operationParent =
      it "parent \".\" == \".\""
         (parent $(mkRelDir ".") == $(mkRelDir "."))
 
+-- | The 'splitDrive' operation.
+operationSplitDrive :: Spec
+operationSplitDrive =
+  do it "splitDrive \"/dir\" == (\"/\", Just \"dir\")"
+        (splitDrive $(mkAbsDir "/dir") == ($(mkAbsDir "/"), Just $(mkRelDir "dir")))
+     it "splitDrive \"/file\" == (\"/\", Just \"file\")"
+        (splitDrive $(mkAbsFile "/file") == ($(mkAbsDir "/"), Just $(mkRelFile "file")))
+     it "splitDrive \"/\" == (\"/\", Nothing)"
+        (splitDrive $(mkAbsDir "/") == ($(mkAbsDir "/"), Nothing))
+
+-- | The 'isDrive' operation.
+operationIsDrive :: Spec
+operationIsDrive =
+  do it "isDrive \"/\" == True"
+        (isDrive $(mkAbsDir "/") == True)
+     it "isDrive \"/dir\" == False"
+        (isDrive $(mkAbsDir "/dir") == False)
+
 -- | The 'isProperPrefixOf' operation.
 operationIsProperPrefixOf :: Spec
 operationIsProperPrefixOf =

test/ValidityTest.hs

@@ -50,6 +50,8 @@ spec =
       describe "stripProperPrefix" operationStripDir
       describe "isProperPrefixOf" operationIsParentOf
       describe "parent" operationParent
+      describe "splitDrive" operationSplitDrive
+      describe "takeDrive" operationTakeDrive
       describe "filename" operationFilename
       describe "dirname" operationDirname
     describe "Extensions" extensionsSpec
@@ -101,6 +103,22 @@ operationParent = do
   it "produces a valid path on when passed a valid rel directory path" $ do
     producesValid (parent :: Path Rel Dir -> Path Rel Dir)
 
+-- | The 'splitDrive' operation.
+operationSplitDrive :: Spec
+operationSplitDrive = do
+  it "produces valid paths on when passed a valid directory path" $ do
+    producesValid (splitDrive :: Path Abs Dir -> (Path Abs Dir, Maybe (Path Rel Dir)))
+  it "produces valid paths on when passed a valid file path" $ do
+    producesValid (splitDrive :: Path Abs File -> (Path Abs Dir, Maybe (Path Rel File)))
+
+-- | The 'takeDrive' operation.
+operationTakeDrive :: Spec
+operationTakeDrive = do
+  it "produces a valid path on when passed a valid directory path" $ do
+    producesValid (takeDrive :: Path Abs Dir -> Path Abs Dir)
+  it "produces a valid path on when passed a valid file path" $ do
+    producesValid (takeDrive :: Path Abs File -> Path Abs Dir)
+
 -- | The 'isProperPrefixOf' operation.
 operationIsParentOf :: Spec
 operationIsParentOf = do

test/Windows.hs

@@ -30,6 +30,8 @@ spec =
      describe "Operations: stripProperPrefix" operationStripProperPrefix
      describe "Operations: isProperPrefixOf" operationIsProperPrefixOf
      describe "Operations: parent" operationParent
+     describe "Operations: splitDrive" operationSplitDrive
+     describe "Operations: isDrive" operationIsDrive
      describe "Operations: filename" operationFilename
      describe "Operations: dirname" operationDirname
      describe "Operations: extensions" (extensionOperations "C:\\")
@@ -118,6 +120,34 @@ operationParent =
      it "parent \".\" == \".\""
         (parent $(mkRelDir ".") == $(mkRelDir "."))
 
+-- | The 'splitDrive' operation.
+operationSplitDrive :: Spec
+operationSplitDrive =
+  do it "splitDrive \"C:/dir\" == (\"C:/\", Just \"dir\")"
+        (splitDrive $(mkAbsDir "C:/dir") == ($(mkAbsDir "C:/"), Just $(mkRelDir "dir")))
+     it "splitDrive \"C:\\dir\" == (\"C:\\\", Just \"dir\")"
+        (splitDrive $(mkAbsDir "C:\\dir") == ($(mkAbsDir "C:\\"), Just $(mkRelDir "dir")))
+     it "splitDrive \"C:/file\" == (\"C:/\", Just \"file\")"
+        (splitDrive $(mkAbsFile "C:/file") == ($(mkAbsDir "C:/"), Just $(mkRelFile "file")))
+     it "splitDrive \"C:\\file\" == (\"C:\\\", Just \"file\")"
+        (splitDrive $(mkAbsFile "C:\\file") == ($(mkAbsDir "C:\\"), Just $(mkRelFile "file")))
+     it "splitDrive \"C:/\" == (\"C:/\", Nothing)"
+        (splitDrive $(mkAbsDir "C:/") == ($(mkAbsDir "C:/"), Nothing))
+     it "splitDrive \"C:\\\" == (\"C:\\\", Nothing)"
+        (splitDrive $(mkAbsDir "C:\\") == ($(mkAbsDir "C:\\"), Nothing))
+
+-- | The 'isDrive' operation.
+operationIsDrive :: Spec
+operationIsDrive =
+  do it "isDrive \"C:/\" == True"
+        (isDrive $(mkAbsDir "C:/") == True)
+     it "isDrive \"C:\\\" == True"
+        (isDrive $(mkAbsDir "C:\\") == True)
+     it "isDrive \"C:/dir\" == False"
+        (isDrive $(mkAbsDir "C:/dir") == False)
+     it "isDrive \"C:\\dir\" == False"
+        (isDrive $(mkAbsDir "C:\\dir") == False)
+
 -- | The 'isProperPrefixOf' operation.
 operationIsProperPrefixOf :: Spec
 operationIsProperPrefixOf =