packages feed

safepath (empty) → 0.1.0.0

raw patch · 6 files changed

+1345/−0 lines, 6 filesdep +basedep +doctestdep +safepathsetup-changed

Dependencies added: base, doctest, safepath, text, validity

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2016 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ safepath.cabal view
@@ -0,0 +1,41 @@+name:                safepath+version:             0.1.0.0+synopsis:            Safe Paths in Haskell+description:         Please see README.md+homepage:            https://github.com/githubuser/safepath#readme+license:             MIT+license-file:        LICENSE+author:              Tom Sydney Kerckhove+maintainer:          syd.kerckhove@gmail.com+copyright:           2016 Tom Sydney Kerckhove+category:            System+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+      Data.Path+    , Data.Path.Internal+  build-depends:+      base                  >= 4.7       && < 5+    , text                  >= 1.2       && < 1.3+    , validity              >= 0.3.0.1   && < 0.4+  default-language:    Haskell2010++test-suite safepath-doctests+  default-language:   Haskell2010+  hs-source-dirs:     test+  type:               exitcode-stdio-1.0+  ghc-options:        -threaded+  main-is:            DocTest.hs+  build-depends:      base+    , doctest               >= 0.11      && < 0.12+    , safepath+  HS-Source-Dirs:     test++++source-repository head+  type:     git+  location: https://github.com/NorfairKing/safepath
+ src/Data/Path.hs view
@@ -0,0 +1,151 @@+module Data.Path+    (+    -- * Safe Path Types++      Path() -- Opaque path on purpose++    , AbsPath+    , RelPath+    , Absolute() -- Phantom anyway+    , Relative() -- Phantom anyway++    -- ** Safe path helper types++    , PathPiece()     -- Opaque path on purpose+    , LastPathPiece() -- Opaque path on purpose+    , Extension()     -- Opaque path on purpose+++    -- * Constructing safe values++    -- ** Constructing safe values safely++    , relpath+    , abspath+    , ext+    , ground++    -- ** Constructing safe values unsafely++    , unsafeRelPathError+    , unsafeAbsPathError+    , unsafePathPieceError+    , unsafeLastPieceError+    , unsafeExtError+++    -- * Rendering safe paths to 'FilePath's++    , toRelFilePath+    , toAbsFilePath+++    -- * Functions involving extension++    -- ** Inspecting extensions++    , takeExtension+    , takeExtensions++    -- ** Adding extensions++    , addExtension+    , (<.>)+    , addExtensions++    -- ** Removing extensions++    , dropExtensionExact+    , dropExtension+    , dropExtensions++    -- ** Replacing extensions++    , replaceExtensionExact+    , replaceExtension+    , (-<.>)+    , replaceExtensions+    , replaceExtensionss++    -- ** Removing given extensions++    , stripExtension+    , stripExtensions++    -- ** Splitting extensions off a path++    , splitExtension+    , splitExtensions++    -- ** Predicates involving extensions++    , hasExtension+++    -- * Functions involving Path pieces++    -- ** File names++    -- *** Inspecting file names++    , takeFileNameExact+    , takeFileName++    -- *** Removing file names++    , dropFileNameExact+    , dropFileName++    -- *** Replacing file names++    , replaceFileNameExact+    , replaceFileName++    -- ** Base names++    -- *** Inspecting base names++    , takeBaseNameExact+    , takeBaseName++    -- *** Replacing base names++    , replaceBaseNameExact+    , replaceBaseName++    -- ** Directories++    -- *** Replacing directories++    , replaceDirectoryExact+    , replaceDirectory++    -- ** Combining paths++    , combineExact+    , combine+    , (</>)++    -- ** Pieces of paths++    , splitPath+    , joinPath+++    -- * Separators++    -- ** Paths++    , pathSeparator+    , pathSeparators+    , isPathSeparator++    -- ** Extension++    , extensionSeparator+    , extensionSeparators+    , isExtensionSeparator++    ) where++import Data.Path.Internal
+ src/Data/Path/Internal.hs view
@@ -0,0 +1,1126 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE IncoherentInstances #-}+module Data.Path.Internal where++import Data.Monoid ((<>))+import Data.Typeable+import GHC.Generics+import Data.Maybe (isJust, fromMaybe)+import Data.String (IsString(..))+import Data.List (intercalate, foldl', stripPrefix)+import Data.Data++import Data.Text (Text)+import qualified Data.Text as T++import Data.Validity++type AbsPath = Path Absolute+type RelPath = Path Relative++data Path rel+    = Path+    { pathPieces      :: [PathPiece]+    , pathLastPiece   :: LastPathPiece+    , pathExtensions  :: [Extension]+    } deriving (Show, Eq, Generic, Data, Typeable)++data Absolute = Absolute+    deriving (Generic, Data, Typeable)++data Relative = Relative+    deriving (Generic, Data, Typeable)++-- Choose nicer ways of printing if the context allows the compiler to figure+-- out what kind of path it is.++instance Show (Path Relative) where+    show = toRelFilePath++instance Show (Path Absolute) where+    show = toAbsFilePath++-- | ONLY for @OverloadedStrings@+-- This instance instance is unsafe and should only be used at own risk,+-- for literals+instance IsString (Path Absolute) where+    fromString = unsafeAbsPathError++-- | ONLY for @OverloadedStrings@+-- This instance instance is unsafe and should only be used at own risk,+-- for literals+instance IsString (Path Relative) where+    fromString = unsafeRelPathError++instance Validity (Path rel) where+    isValid Path{..}+        =  isValid pathPieces+        && isValid pathLastPiece+        && isValid pathExtensions+        && (not (T.null lt) || (null pathPieces && null pathExtensions))+      where+        (LastPathPiece lt) = pathLastPiece++newtype PathPiece = PathPiece Text+    deriving (Eq, Generic, Data, Typeable)++instance Show PathPiece where+    show (PathPiece t) = T.unpack t++instance Validity PathPiece where+    isValid (PathPiece t) = not (T.null t) && not (containsSeparator t)++-- | ONLY for @OverloadedStrings@+-- This instance instance is unsafe and should only be used at own risk,+-- for literals+instance IsString PathPiece where+    fromString = unsafePathPieceError++newtype LastPathPiece = LastPathPiece Text+    deriving (Eq, Generic, Data, Typeable)++instance Show LastPathPiece where+    show (LastPathPiece t) = T.unpack t++instance Validity LastPathPiece where+    isValid (LastPathPiece t) = not (containsSeparator t) && not (containsExtension t)++-- | ONLY for @OverloadedStrings@+-- This instance instance is unsafe and should only be used at own risk,+-- for literals+instance IsString LastPathPiece where+    fromString = unsafeLastPieceError++newtype Extension = Extension Text+    deriving (Eq, Generic, Data, Typeable)++instance Show Extension where+    show (Extension t) = T.unpack t++-- | ONLY for @OverloadedStrings@+-- This instance instance is unsafe and should only be used at own risk,+-- for literals+instance IsString Extension where+    fromString = unsafeExtError++instance Validity Extension where+    isValid (Extension t) = not (T.null t) && not (containsExtension t) && not (containsSeparator t)++pathSeparator :: Char+pathSeparator = '/'++pathSeparators :: [Char]+pathSeparators = [pathSeparator]++-- | Check if a given character is a valid path separator+--+-- >>> isPathSeparator pathSeparator+-- True+-- >>> all isPathSeparator pathSeparators+-- True+isPathSeparator :: Char -> Bool+isPathSeparator = (== pathSeparator)++extensionSeparator :: Char+extensionSeparator = '.'++extensionSeparators :: [Char]+extensionSeparators = [extensionSeparator]++-- | Check if a given character is a valid extension separator+--+-- >>> isExtensionSeparator extensionSeparator+-- True+-- >>> all isExtensionSeparator extensionSeparators+-- True+isExtensionSeparator :: Char -> Bool+isExtensionSeparator = (== extensionSeparator)++containsSatisfied :: (Char -> Bool) -> Text -> Bool+containsSatisfied func = isJust . T.find func++containsSeparator :: Text -> Bool+containsSeparator = containsSatisfied isPathSeparator++containsExtension :: Text -> Bool+containsExtension = containsSatisfied isExtensionSeparator++-- | Construct a relative path from a 'FilePath', failing if+-- the given 'FilePath' does not represent a valid relative path.+--+-- >>> relpath "file"+-- Just file+-- >>> relpath "/file"+-- Nothing+-- >>> relpath "."+-- Just .+-- >>> relpath "/"+-- Nothing+-- >>> relpath ""+-- Nothing+relpath :: FilePath -> Maybe RelPath+relpath [] = Nothing+relpath fp@(c:rest)+    | c == extensionSeparator && null rest = Just emptyPath+    | c == pathSeparator = Nothing+    | last fp == extensionSeparator = Nothing+    | otherwise = do+        let rawPieces = filter (not . T.null) $ T.split (== pathSeparator) $ T.pack fp+        (pieces, lastRawPiece) <- unsnoc $ map PathPiece rawPieces+        let (lastPiece, exts) = splitPiece lastRawPiece+        return $ Path pieces lastPiece exts+++-- | Construct an absolute path from a 'FilePath', failing if+-- the given 'FilePath' does not represent a valid absolute path.+--+-- >>> abspath "/file"+-- Just /file+-- >>> abspath "file"+-- Nothing+-- >>> abspath "/"+-- Just /+-- >>> abspath "."+-- Nothing+-- >>> abspath ""+-- Nothing+abspath :: FilePath -> Maybe AbsPath+abspath [] = Nothing+abspath (c:fp)+  | c == pathSeparator && null fp = Just emptyPath+  | c == pathSeparator = unsafePathTypeCoerse <$> relpath fp+  | otherwise = Nothing++-- | Construct a path piece safely+--+-- >>> pathpiece "file"+-- Just file+-- >>> pathpiece "with.dot"+-- Just with.dot+-- >>> pathpiece "with/slash"+-- Nothing+pathpiece :: String -> Maybe PathPiece+pathpiece = constructValid . PathPiece . T.pack++-- | Construct a last path piece safely+--+-- >>> lastpiece "file"+-- Just file+-- >>> lastpiece "with.dot"+-- Nothing+lastpiece :: String -> Maybe LastPathPiece+lastpiece = constructValid . LastPathPiece . T.pack++-- | Construct an extension safely+--+-- >>> ext "extension"+-- Just extension+-- >>> ext ".ext"+-- Nothing+-- >>> ext ""+-- Nothing+ext :: String -> Maybe Extension+ext = constructValid . Extension . T.pack++-- | Ground a filepath on an absolute path.+-- This will try to parse the given @FilePath@ as an absolute path and take it+-- if that works. Otherwise it will try to parse it an a relative path and+-- append it to the given @AbsPath@+--+-- >>> ground "/home/user" "relative/path"+-- Just /home/user/relative/path+-- >>> ground "/home/user" "/absolute/path"+-- Just /absolute/path+-- >>> ground "/home/user" "."+-- Just /home/user+-- >>> ground "/home/user" "/"+-- Just /+-- >>> ground "/" "."+-- Just /+-- >>> ground "/anything" ""+-- Nothing+ground :: AbsPath -> FilePath -> Maybe AbsPath+ground ap fp = case abspath fp of+    Just a -> Just a+    Nothing -> case relpath fp of+        Just r -> Just $ ap </> r+        Nothing -> Nothing++-- | Construct a relative path, throwing an 'error' if 'relpath' would fail.+unsafeRelPathError :: FilePath -> RelPath+unsafeRelPathError fp+    = constructValidUnsafe+    . fromMaybe (error $ "Invalid path: " ++ fp)+    . relpath $ fp+++-- | Construct an absolute path, throwing an 'error' if 'abspath' would fail.+unsafeAbsPathError :: FilePath -> AbsPath+unsafeAbsPathError fp+    = constructValidUnsafe+    . fromMaybe (error $ "Invalid path: " ++ fp)+    . abspath $ fp++-- | Construct an extension, throwing an 'error' if 'pathpiece' would fail.+unsafePathPieceError :: String -> PathPiece+unsafePathPieceError s+    = constructValidUnsafe+    . fromMaybe (error $ "Invalid path piece: " ++ s)+    . pathpiece $ s++-- | Construct an extension, throwing an 'error' if 'lastpiece' would fail.+unsafeLastPieceError :: String -> LastPathPiece+unsafeLastPieceError s+    = constructValidUnsafe+    . fromMaybe (error $ "Invalid last path piece: " ++ s)+    . lastpiece $ s++-- | Construct an extension, throwing an 'error' if 'ext' would fail.+unsafeExtError :: String -> Extension+unsafeExtError e+    = constructValidUnsafe+    . fromMaybe (error $ "Invalid extension: " ++ e)+    . ext $ e++-- | Render a relative filepath to a 'FilePath'+toRelFilePath :: RelPath -> FilePath+toRelFilePath (Path [] (LastPathPiece "") []) = [extensionSeparator]+toRelFilePath Path{..}+    =  intercalate [pathSeparator] (map renderPiece pathPieces ++ [renderLastPiece pathLastPiece])+    ++ renderExtensions pathExtensions++-- | Render an absolute filepath to a 'FilePath'+toAbsFilePath :: AbsPath -> FilePath+toAbsFilePath (Path [] (LastPathPiece "") []) = [pathSeparator]+toAbsFilePath p = (pathSeparator:) . toRelFilePath . unsafePathTypeCoerse $ p++-- | Take the last extension of a filepath+--+-- >>> takeExtension ("/directory/path.ext" :: AbsPath)+-- Just ext+-- >>> takeExtension ("file.tar.gz" :: RelPath)+-- Just gz+-- >>> takeExtension ("file" :: RelPath)+-- Nothing+--+-- Replaces @System.FilePath.takeExtension@+takeExtension :: Path rel -> Maybe Extension+takeExtension (Path _ _ es) = lastMay es++-- | Take all extensions of a given path in the form of a list+--+-- >>> takeExtensions ("/directory/path.ext" :: AbsPath)+-- [ext]+-- >>> takeExtensions ("file.tar.gz" :: RelPath)+-- [tar,gz]+--+-- Replaces @System.FilePath.takeExtensions@+takeExtensions :: Path rel -> [Extension]+takeExtensions (Path _ _ es) = es++-- | Replace the last extension of a path, exactly+--+-- This will fail if the given path has no extension+--+-- >>> replaceExtensionExact "dir/file.ext1.ext2"  "ext3" :: Maybe RelPath+-- Just dir/file.ext1.ext3+-- >>> replaceExtensionExact "dir/file.ext1"       "ext2" :: Maybe RelPath+-- Just dir/file.ext2+-- >>> replaceExtensionExact "dir/file"            "ext"  :: Maybe RelPath+-- Nothing+-- >>> replaceExtensionExact "/dir/file.ext1.ext2" "ext3" :: Maybe AbsPath+-- Just /dir/file.ext1.ext3+-- >>> replaceExtensionExact "/dir/file.ext1"      "ext2" :: Maybe AbsPath+-- Just /dir/file.ext2+-- >>> replaceExtensionExact "/dir/file"           "ext"  :: Maybe AbsPath+-- Nothing+-- >>> replaceExtensionExact "." "ext" :: Maybe RelPath+-- Nothing+-- >>> replaceExtensionExact "/" "ext" :: Maybe AbsPath+-- Nothing+replaceExtensionExact :: Path rel -> Extension -> Maybe (Path rel)+replaceExtensionExact path extension = do+  path' <- dropExtensionExact path+  return $ path' <.> extension++-- | Replace the last extension of a path+--+-- This will first remove one extension and then add the given extension.+--+-- > replaceExtension path extension = dropExtension path <.> extension+--+-- >>> replaceExtension "dir/file.ext1.ext2"  "ext3" :: RelPath+-- dir/file.ext1.ext3+-- >>> replaceExtension "dir/file.ext1"       "ext2" :: RelPath+-- dir/file.ext2+-- >>> replaceExtension "dir/file"            "ext"  :: RelPath+-- dir/file.ext+-- >>> replaceExtension "/dir/file.ext1.ext2" "ext3" :: AbsPath+-- /dir/file.ext1.ext3+-- >>> replaceExtension "/dir/file.ext1"      "ext2" :: AbsPath+-- /dir/file.ext2+-- >>> replaceExtension "/dir/file"           "ext"  :: AbsPath+-- /dir/file.ext+-- >>> replaceExtension "." "ext" :: RelPath+-- .+-- >>> replaceExtension "/" "ext" :: AbsPath+-- /+--+-- Replaces @System.FilePath.replaceExtension@+replaceExtension :: Path rel -> Extension -> Path rel+replaceExtension path extension = dropExtension path <.> extension++-- | Replace the last extension of a path (equivalent to 'replaceExtension')+--+-- >>> "dir/file.ext1.ext2" -<.> "ext3"   :: RelPath+-- dir/file.ext1.ext3+-- >>> "dir/file.ext1" -<.> "ext2"        :: RelPath+-- dir/file.ext2+-- >>> "dir/file" -<.> "ext"              :: RelPath+-- dir/file.ext+-- >>> "/dir/file.ext1.ext2" -<.> "ext3"  :: AbsPath+-- /dir/file.ext1.ext3+-- >>> "/dir/file.ext1" -<.> "ext2"       :: AbsPath+-- /dir/file.ext2+-- >>> "/dir/file" -<.> "ext"             :: AbsPath+-- /dir/file.ext+-- >>> "." -<.> "ext" :: RelPath+-- .+-- >>> "/" -<.> "ext" :: AbsPath+-- /+--+-- Replaces @System.FilePath.(-<.>)@+(-<.>) :: Path rel -> Extension -> Path rel+(-<.>) = replaceExtension++-- | Replace all the extensions of a path with the given extension+--+-- >>> replaceExtensions "dir/file.ext1.ext2"  "ext3" :: RelPath+-- dir/file.ext3+-- >>> replaceExtensions "dir/file.ext1"       "ext3" :: RelPath+-- dir/file.ext3+-- >>> replaceExtensions "dir/file"            "ext3" :: RelPath+-- dir/file.ext3+-- >>> replaceExtensions "/dir/file.ext1.ext2" "ext3" :: AbsPath+-- /dir/file.ext3+-- >>> replaceExtensions "/dir/file.ext1"      "ext3" :: AbsPath+-- /dir/file.ext3+-- >>> replaceExtensions "/dir/file"           "ext3" :: AbsPath+-- /dir/file.ext3+-- >>> replaceExtensions "." "ext" :: RelPath+-- .+-- >>> replaceExtensions "/" "ext" :: AbsPath+-- /++-- TODO(syd) exact version+replaceExtensions :: Path rel -> Extension -> Path rel+replaceExtensions p e = replaceExtensionss p [e]++-- | Replace all the extensions of a path with the given list of extensions+--+-- >>> replaceExtensionss "dir/file.ext1.ext2"  ["ext3", "ext4"] :: RelPath+-- dir/file.ext3.ext4+-- >>> replaceExtensionss "dir/file.ext1"       ["ext3", "ext4"] :: RelPath+-- dir/file.ext3.ext4+-- >>> replaceExtensionss "dir/file"            ["ext3", "ext4"] :: RelPath+-- dir/file.ext3.ext4+-- >>> replaceExtensionss "/dir/file.ext1.ext2" ["ext3", "ext4"] :: AbsPath+-- /dir/file.ext3.ext4+-- >>> replaceExtensionss "/dir/file.ext1"      ["ext3", "ext4"] :: AbsPath+-- /dir/file.ext3.ext4+-- >>> replaceExtensionss "/dir/file"           ["ext3", "ext4"] :: AbsPath+-- /dir/file.ext3.ext4+-- >>> replaceExtensionss "." ["ext1", "ext2"] :: RelPath+-- .+-- >>> replaceExtensionss "/" ["ext1", "ext2"] :: AbsPath+-- /+replaceExtensionss :: Path rel -> [Extension] -> Path rel+replaceExtensionss p@(Path ps lp _) es+  | isEmptyPath p = emptyPath+  | otherwise = (Path ps lp es)++-- | Drop the last extension of a path, exactly+--+-- This will fail if the given path has no extensions+--+-- >>> dropExtensionExact "dir/file.ext1.ext2" :: Maybe RelPath+-- Just dir/file.ext1+-- >>> dropExtensionExact "dir/file.ext" :: Maybe RelPath+-- Just dir/file+-- >>> dropExtensionExact "dir/file" :: Maybe RelPath+-- Nothing+-- >>> dropExtensionExact "/dir/file.ext1.ext2" :: Maybe AbsPath+-- Just /dir/file.ext1+-- >>> dropExtensionExact "/dir/file.ext" :: Maybe AbsPath+-- Just /dir/file+-- >>> dropExtensionExact "/dir/file" :: Maybe AbsPath+-- Nothing+-- >>> dropExtensionExact "." :: Maybe RelPath+-- Nothing+-- >>> dropExtensionExact "/" :: Maybe AbsPath+-- Nothing+dropExtensionExact :: Path rel -> Maybe (Path rel)+dropExtensionExact path@(Path _ _ es) = do+    is <- initMay es+    return $ path { pathExtensions = is }++-- | Drop the last extension of a path+--+-- >>> dropExtension "dir/file.ext1.ext2" :: RelPath+-- dir/file.ext1+-- >>> dropExtension "dir/file.ext" :: RelPath+-- dir/file+-- >>> dropExtension "dir/file" :: RelPath+-- dir/file+-- >>> dropExtension "/dir/file.ext1.ext2" :: AbsPath+-- /dir/file.ext1+-- >>> dropExtension "/dir/file.ext" :: AbsPath+-- /dir/file+-- >>> dropExtension "/dir/file" :: AbsPath+-- /dir/file+-- >>> dropExtension "." :: RelPath+-- .+-- >>> dropExtension "/" :: AbsPath+-- /+--+-- Replaces @System.FilePath.dropExtension@+dropExtension :: Path rel -> Path rel+dropExtension path = path+    { pathExtensions = reverse . drop 1 . reverse $ pathExtensions path }++-- | Drop all extensions of a path+--+-- >>> dropExtensions "dir/file.ext1.ext2" :: RelPath+-- dir/file+-- >>> dropExtensions "dir/file.ext" :: RelPath+-- dir/file+-- >>> dropExtensions "dir/file" :: RelPath+-- dir/file+-- >>> dropExtensions "/dir/file.ext1.ext2" :: AbsPath+-- /dir/file+-- >>> dropExtensions "/dir/file.ext" :: AbsPath+-- /dir/file+-- >>> dropExtensions "/dir/file" :: AbsPath+-- /dir/file+-- >>> dropExtensions "." :: RelPath+-- .+-- >>> dropExtensions "/" :: AbsPath+-- /+--+-- Replaces @System.FilePath.dropExtensions@++-- TODO(syd) exact version+dropExtensions :: Path rel -> Path rel+dropExtensions (Path ps lp _) = Path ps lp []++-- | Add an extension to a path+--+-- >>> addExtension "/directory/path" "ext" :: AbsPath+-- /directory/path.ext+-- >>> addExtension "directory/path"  "ext" :: RelPath+-- directory/path.ext+--+-- This will not override the extension if there already is an extension.+-- It will only add the given extension on top of it+--+-- >>> addExtension "/directory/path.ext1" "ext2" :: AbsPath+-- /directory/path.ext1.ext2+-- >>> addExtension "directory/path.ext1"  "ext2" :: RelPath+-- directory/path.ext1.ext2+--+-- This will not add an extension if the path is empty.+--+-- >>> addExtension "." "ext" :: RelPath+-- .+-- >>> addExtension "/" "ext" :: AbsPath+-- /+--+-- Replaces @System.FilePath.addExtension@+addExtension :: Path rel -> Extension -> Path rel+addExtension path extension+    | isEmptyPath path = path+    | otherwise = path+      { pathExtensions = pathExtensions path ++ [extension] }++-- | Add an extension to a path (equivalent to 'addExtension')+--+-- >>> "/directory/path" <.> "ext" :: AbsPath+-- /directory/path.ext+-- >>> "directory/path"  <.> "ext" :: RelPath+-- directory/path.ext+-- >>> "/directory/path.ext1" <.> "ext2" :: AbsPath+-- /directory/path.ext1.ext2+-- >>> "directory/path.ext1"  <.> "ext2" :: RelPath+-- directory/path.ext1.ext2+-- >>> "." <.> "ext" :: RelPath+-- .+-- >>> "/" <.> "ext" :: AbsPath+-- /+--+-- Replaces @System.FilePath.(<.>)@+(<.>) :: Path rel -> Extension -> Path rel+(<.>) = addExtension++-- | Add a list of extensions to a path+--+-- >>> addExtensions "/directory/path" ["ext1", "ext2"] :: AbsPath+-- /directory/path.ext1.ext2+-- >>> addExtensions "directory/path"  ["ext1", "ext2"] :: RelPath+-- directory/path.ext1.ext2+--+-- >>> addExtensions "/directory/path.ext1" ["ext2", "ext3"] :: AbsPath+-- /directory/path.ext1.ext2.ext3+-- >>> addExtensions "directory/path.ext1"  ["ext2", "ext3"] :: RelPath+-- directory/path.ext1.ext2.ext3+--+-- >>> addExtensions "." ["ext1", "ext2"] :: RelPath+-- .+-- >>> addExtensions "/" ["ext1", "ext2"] :: AbsPath+-- /+--+-- This operation is an identity function if the given list of extensions+-- is empty.+addExtensions :: Path rel -> [Extension] -> Path rel+addExtensions = foldl' addExtension+++-- | Drop the given extension from a FilePath.+-- Fails if the FilePath does not have the given extension.+--+-- >>> stripExtension "foo.x.hs.o" "o"    :: Maybe RelPath+-- Just foo.x.hs+-- >>> stripExtension "foo.x.hs.o" "hs"   :: Maybe RelPath+-- Nothing+-- >>> stripExtension "a.b.c.d"    "d"    :: Maybe RelPath+-- Just a.b.c+-- >>> stripExtension "foo.bar"    "baz"  :: Maybe RelPath+-- Nothing+-- >>> stripExtension "foobar"     "bar"  :: Maybe RelPath+-- Nothing+--+-- Replaces @System.FilePath.stripExtension@+stripExtension :: Path rel -> Extension -> Maybe (Path rel)+stripExtension p e = stripExtensions p [e]++-- | Drop the given extensions from a FilePath.+-- Fails if the FilePath does not have all of the given extensions.+--+-- >>> stripExtensions "foo.x.hs.o" ["hs", "o"]      :: Maybe RelPath+-- Just foo.x+-- >>> stripExtensions "foo.x.hs.o" ["o", "hs"]      :: Maybe RelPath+-- Nothing+-- >>> stripExtensions "a.b.c.d"    ["c", "d"]       :: Maybe RelPath+-- Just a.b+-- >>> stripExtensions "foo.bar"    ["baz", "quux"]  :: Maybe RelPath+-- Nothing+-- >>> stripExtensions "foobar"     ["bar"]          :: Maybe RelPath+-- Nothing+stripExtensions :: Path rel -> [Extension] -> Maybe (Path rel)+stripExtensions (Path ps lp es) esq+    = (Path ps lp . reverse) <$> stripPrefix (reverse esq) (reverse es)++-- | Split off the extensions from a path+--+-- >>> splitExtension ("dir/file.ext1.ext2" :: RelPath)+-- Just (dir/file.ext1,ext2)+-- >>> splitExtension ("dir/file.ext" :: RelPath)+-- Just (dir/file,ext)+-- >>> splitExtension ("dir/file" :: RelPath)+-- Nothing+-- >>> splitExtension ("/dir/file.ext1.ext2" :: AbsPath)+-- Just (/dir/file.ext1,ext2)+-- >>> splitExtension ("/dir/file.ext" :: AbsPath)+-- Just (/dir/file,ext)+-- >>> splitExtension ("/dir/file" :: AbsPath)+-- Nothing+-- >>> splitExtension ("." :: RelPath)+-- Nothing+-- >>> splitExtension ("/" :: AbsPath)+-- Nothing+--+-- Replaces @System.FilePath.splitExtension@+splitExtension :: Path rel -> Maybe (Path rel, Extension)+splitExtension p = (,) (dropExtension p) <$> takeExtension p++-- | Split off the extensions from a path+--+-- >>> splitExtensions ("dir/file.ext1.ext2" :: RelPath)+-- (dir/file,[ext1,ext2])+-- >>> splitExtensions ("dir/file.ext" :: RelPath)+-- (dir/file,[ext])+-- >>> splitExtensions ("dir/file" :: RelPath)+-- (dir/file,[])+-- >>> splitExtensions ("/dir/file.ext1.ext2" :: AbsPath)+-- (/dir/file,[ext1,ext2])+-- >>> splitExtensions ("/dir/file.ext" :: AbsPath)+-- (/dir/file,[ext])+-- >>> splitExtensions ("/dir/file" :: AbsPath)+-- (/dir/file,[])+-- >>> splitExtensions ("." :: RelPath)+-- (.,[])+-- >>> splitExtensions ("/" :: AbsPath)+-- (/,[])+splitExtensions :: Path rel -> (Path rel, [Extension])+splitExtensions p = (dropExtensions p, takeExtensions p)++-- | Check whether the given filepath has any extensions+--+-- >>> hasExtension ("/directory/path.ext" :: AbsPath)+-- True+-- >>> hasExtension ("/directory/path"     :: AbsPath)+-- False+--+-- Replaces @System.FilePath.hasExtension@+hasExtension :: Path rel -> Bool+hasExtension = not . null . takeExtensions++-- | Split a path into all but the last piece and the last piece and the+-- extensions+--+-- >>> splitFileName ("/directory/file.ext" :: AbsPath)+-- (/directory,file.ext)+-- >>> splitFileName ("file/bob.txt" :: RelPath)+-- (file,bob.txt)+-- >>> splitFileName ("file" :: RelPath)+-- (.,file)+-- >>> splitFileName ("dir.ext/file.ext" :: RelPath)+-- (dir.ext,file.ext)+splitFileName :: Path rel -> (Path rel, RelPath)+splitFileName p = (dropFileName p, takeFileName p)++-- | Take the last piece and the extensions, exactly.+--+-- This will evaluate to 'Nothing' if the given path is empty+--+-- >>> takeFileNameExact ("/directory/file.ext" :: AbsPath)+-- Just file.ext+-- >>> takeFileNameExact ("file/bob.txt" :: RelPath)+-- Just bob.txt+-- >>> takeFileNameExact ("file" :: RelPath)+-- Just file+-- >>> takeFileNameExact ("dir.ext/file.ext" :: RelPath)+-- Just file.ext+-- >>> takeFileNameExact ("." :: RelPath)+-- Nothing+-- >>> takeFileNameExact ("/" :: AbsPath)+-- Nothing+--+-- Replaces @System.FilePath.takeFileName@+takeFileNameExact :: Path rel -> Maybe RelPath+takeFileNameExact p@(Path _ lp es)+    | isEmptyPath p = Nothing+    | otherwise = Just $ Path [] lp es++-- | Take the last piece and the extensions.+--+-- This will evaluate to the empty (relative) path if the given path is empty.+--+-- >>> takeFileName ("/directory/file.ext" :: AbsPath)+-- file.ext+-- >>> takeFileName ("file/bob.txt" :: RelPath)+-- bob.txt+-- >>> takeFileName ("file" :: RelPath)+-- file+-- >>> takeFileName ("dir.ext/file.ext" :: RelPath)+-- file.ext+-- >>> takeFileName ("." :: RelPath)+-- .+-- >>> takeFileName ("/" :: AbsPath)+-- .+--+-- Replaces @System.FilePath.takeFileName@+takeFileName :: Path rel -> RelPath+takeFileName p+    = case takeFileNameExact p of+          Nothing -> emptyPath+          Just r  -> r++-- | Replace the last piece of a path with the given last piece.+--+-- >>> replaceFileNameExact "/directory/other.txt" "file.ext" :: Maybe AbsPath+-- Just /directory/file.ext+-- >>> replaceFileNameExact "." "file.ext" :: Maybe RelPath+-- Just file.ext+-- >>> replaceFileNameExact "/" "file.ext" :: Maybe AbsPath+-- Just /file.ext+--+-- If the given path piece is degenerate, this is what happens:+--+-- >>> replaceFileNameExact "/directory/other.txt" "..." :: Maybe AbsPath+-- Nothing+replaceFileNameExact :: Path rel -> PathPiece -> Maybe (Path rel)+replaceFileNameExact (Path ps _ _) p+    = let (lp, es) = splitPiece p+      in if isEmptyLastPathPiece lp+         && (not (null es) || not (null ps))+          then Nothing+          else Just $ Path ps lp es++-- | Replace the last piece of a path with the given last piece.+--+-- >>> replaceFileName "/directory/other.txt" "file.ext" :: AbsPath+-- /directory/file.ext+-- >>> replaceFileName "." "file.ext" :: RelPath+-- file.ext+-- >>> replaceFileName "/" "file.ext" :: AbsPath+-- /file.ext+--+-- If the given path piece is degenerate, this is what happens:+--+-- >>> replaceFileName "/directory/other.txt" "..." :: AbsPath+-- /directory+replaceFileName :: Path rel -> PathPiece -> Path rel+replaceFileName path p+    = case replaceFileNameExact path p of+        Nothing -> dropFileName path+        Just rs -> rs++-- | Drop the last piece of a path, exactly+--+-- >>> dropFileNameExact ("directory/file.ext" :: RelPath)+-- Just directory+-- >>> dropFileNameExact ("/directory/file.ext" :: AbsPath)+-- Just /directory+--+-- This evaluates to Nothing when given an empty path+--+-- >>> dropFileNameExact ("/" :: AbsPath)+-- Nothing+-- >>> dropFileNameExact ("." :: RelPath)+-- Nothing+dropFileNameExact :: Path rel -> Maybe (Path rel)+dropFileNameExact (Path psc _ _)+    = case unsnoc psc of+        Nothing -> Nothing+        Just (ps, p) ->+            let (lp, es) = splitPiece p+            in if isEmptyLastPathPiece lp+               then Nothing -- TODO(syd) fixme: really ugly+               else Just $ Path ps lp es++-- | Drop the last piece of a path+--+-- >>> dropFileName ("directory/file.ext" :: RelPath)+-- directory+-- >>> dropFileName ("/directory/file.ext" :: AbsPath)+-- /directory+--+-- This evaluates to an empty path when given an empty path+--+-- >>> dropFileName ("/" :: AbsPath)+-- /+-- >>> dropFileName ("." :: RelPath)+-- .+--+-- Replaces @System.FilePath.dropFileName@ and @System.FilePath.takeDirectory@+dropFileName :: Path rel -> Path rel+dropFileName p+    = case dropFileNameExact p of+        Nothing -> emptyPath+        Just rs -> rs++-- | Take the last piece (no extensions)+--+-- >>> takeBaseNameExact ("file.ext" :: RelPath)+-- Just file+-- >>> takeBaseNameExact ("dir/and/file.ext" :: RelPath)+-- Just file+--+-- This will evaluate to Nothing when given an empty path:+--+-- >>> takeBaseNameExact ("." :: RelPath)+-- Nothing+-- >>> takeBaseNameExact ("/" :: AbsPath)+-- Nothing+takeBaseNameExact :: Path rel -> Maybe LastPathPiece+takeBaseNameExact p@(Path _ lp _)+    | isEmptyPath p = Nothing+    | otherwise = Just lp++-- | Take the last piece (no extensions)+--+-- >>> takeBaseName ("file.ext" :: RelPath)+-- file+-- >>> takeBaseName ("dir/and/file.ext" :: RelPath)+-- file+--+-- This will evaluate to an empty last path piece when given an empty path:+--+-- Replaces @System.FilePath.takeBaseName@+takeBaseName :: Path rel -> LastPathPiece+takeBaseName p+    = case takeBaseNameExact p of+        Nothing -> emptyLastPathPiece+        Just rs -> rs++-- | Replace the last piece exactly: fails on empty last piece+--+-- >>> replaceBaseNameExact "file.ext" "piece" :: Maybe RelPath+-- Just piece.ext+-- >>> replaceBaseNameExact "." "thing" :: Maybe RelPath+-- Just thing+-- >>> replaceBaseNameExact "/" "thing" :: Maybe AbsPath+-- Just /thing+-- >>> replaceBaseNameExact "/directory/file" "" :: Maybe AbsPath+-- Nothing+replaceBaseNameExact :: Path rel -> LastPathPiece -> Maybe (Path rel)+replaceBaseNameExact (Path ps _ es) lp+    | isEmptyLastPathPiece lp = Nothing+    | otherwise = Just $ Path ps lp es++-- | Replace the last piece+--+-- >>> replaceBaseName "file.ext" "piece" :: RelPath+-- piece.ext+-- >>> replaceBaseName "." "thing" :: RelPath+-- thing+-- >>> replaceBaseName "/" "thing" :: AbsPath+-- /thing+-- >>> replaceBaseName "/directory/file" "" :: AbsPath+-- /directory+--+-- Replaces @System.FilePath.replaceBaseName@+replaceBaseName :: Path rel -> LastPathPiece -> Path rel+replaceBaseName p@(Path ps _ es) lp+    | isEmptyLastPathPiece lp = dropFileName p+    | otherwise = Path ps lp es++-- | Replace everthing but the last piece, exactly+--+-- >>> replaceDirectoryExact ("/dir/and/file" :: AbsPath) ("other/directory" :: RelPath)+-- Just other/directory/file+--+-- This will evaluate to 'Nothing' if the first argument is an empty path.+--+-- >>> replaceDirectoryExact ("." :: RelPath) ("a/directory" :: RelPath)+-- Nothing+-- >>> replaceDirectoryExact ("/" :: AbsPath) ("a/directory" :: RelPath)+-- Nothing+--+--+-- This will evaluate to 'Nothing' if the second argument is an empty path.+--+-- >>> replaceDirectoryExact ("dir/file" :: RelPath) ("." :: RelPath)+-- Nothing+-- >>> replaceDirectoryExact ("dir/file" :: RelPath) ("/" :: AbsPath)+-- Nothing+replaceDirectoryExact :: Path r -> Path s -> Maybe (Path s)+replaceDirectoryExact p@(Path _ lp es) q@(Path ps' lp' es')+    | isEmptyPath p = Nothing+    | isEmptyPath q = Nothing+    | otherwise =+        let p = combineLastAndExtensions lp' es'+        in Just $ Path (ps' ++ [p]) lp es++-- | Replace everthing but the last piece+--+-- >>> replaceDirectory ("/dir/and/file" :: AbsPath) ("other/directory" :: RelPath)+-- other/directory/file+-- >>> replaceDirectory ("." :: RelPath) ("a/directory" :: RelPath)+-- a/directory+-- >>> replaceDirectory ("/" :: AbsPath) ("a/directory" :: RelPath)+-- a/directory+-- >>> replaceDirectory ("dir/file" :: RelPath) ("." :: RelPath)+-- file+-- >>> replaceDirectory ("dir/file" :: RelPath) ("/" :: AbsPath)+-- /file+--+-- Replaces @System.FilePath.replaceDirectory@+replaceDirectory :: Path r -> Path s -> Path s+replaceDirectory p@(Path _ lp es) q@(Path ps' lp' es')+    | isEmptyPath p = q+    | isEmptyPath q = Path [] lp es+    | otherwise =+        let p = combineLastAndExtensions lp' es'+        in Path (ps' ++ [p]) lp es++-- | Combine two paths, exactly+--+-- If the first path has extensions, they will be appended to the last+-- pathpiece before concatenation+--+-- >>> combineExact "/directory/path" "another/path.ext" :: Maybe AbsPath+-- Just /directory/path/another/path.ext+-- >>> combineExact "directory/path"  "another/path.ext" :: Maybe RelPath+-- Just directory/path/another/path.ext+-- >>> combineExact "/file.ext1.ext2" "other/file.ext3"  :: Maybe AbsPath+-- Just /file.ext1.ext2/other/file.ext3+-- >>> combineExact "file.ext1.ext2"  "other/file.ext3"  :: Maybe RelPath+-- Just file.ext1.ext2/other/file.ext3+--+-- This evaluates to 'Nothing' if any of the given paths are empty+--+-- >>> combineExact "." "file.ext" :: Maybe RelPath+-- Nothing+-- >>> combineExact "/" "file.ext" :: Maybe AbsPath+-- Nothing+combineExact :: Path rel -> RelPath -> Maybe (Path rel)+combineExact p1 p2+    | isEmptyPath p1 || isEmptyPath p2 = Nothing+    | otherwise = Just Path+        { pathPieces =+            pathPieces p1+            +++            [combineLastAndExtensions (pathLastPiece p1) (pathExtensions p1)]+            +++            pathPieces p2+        , pathLastPiece = pathLastPiece p2+        , pathExtensions = pathExtensions p2+        }++-- | Combine two paths+--+-- If the first path has extensions, they will be appended to the last+-- pathpiece before concatenation+--+-- >>> combine "/directory/path" "another/path.ext" :: AbsPath+-- /directory/path/another/path.ext+-- >>> combine "directory/path"  "another/path.ext" :: RelPath+-- directory/path/another/path.ext+-- >>> combine "/file.ext1.ext2" "other/file.ext3"  :: AbsPath+-- /file.ext1.ext2/other/file.ext3+-- >>> combine "file.ext1.ext2"  "other/file.ext3"  :: RelPath+-- file.ext1.ext2/other/file.ext3+--+-- This treats empty paths as identities to the operation.+--+-- >>> combine "file.ext" "." :: RelPath+-- file.ext+-- >>> combine "." "file.ext" :: RelPath+-- file.ext+-- >>> combine "/" "file.ext" :: AbsPath+-- /file.ext+-- >>> combine "." "." :: RelPath+-- .+-- >>> combine "/" "." :: AbsPath+-- /+--+-- Replaces @System.FilePath.combine@+combine :: Path rel -> RelPath -> Path rel+combine p1 p2+    | isEmptyPath p1 && isEmptyPath p2 = emptyPath+    | isEmptyPath p2 = p1+    | isEmptyPath p1 = unsafePathTypeCoerse p2+    | otherwise = Path+        { pathPieces =+            pathPieces p1+            +++            [combineLastAndExtensions (pathLastPiece p1) (pathExtensions p1)]+            +++            pathPieces p2+        , pathLastPiece = pathLastPiece p2+        , pathExtensions = pathExtensions p2+        }++-- | Combine two paths+--+-- equivalent to 'combine'+--+-- >>> "/directory/path" </> "another/path.ext" :: AbsPath+-- /directory/path/another/path.ext+-- >>> "directory/path"  </> "another/path.ext" :: RelPath+-- directory/path/another/path.ext+-- >>> "/file.ext1.ext2" </> "other/file.ext3"  :: AbsPath+-- /file.ext1.ext2/other/file.ext3+-- >>> "file.ext1.ext2"  </> "other/file.ext3"  :: RelPath+-- file.ext1.ext2/other/file.ext3+-- >>> "." </> "file.ext" :: RelPath+-- file.ext+-- >>> "/" </> "file.ext" :: AbsPath+-- /file.ext+--+-- Replaces @System.FilePath.(</>)@+(</>) :: Path rel -> RelPath -> Path rel+(</>) = combine++-- | Split a path up into pieces+--+-- >>> splitPath ("/a/full/absolute/directory/path" :: AbsPath)+-- [a,full,absolute,directory,path]+splitPath :: Path rel -> [PathPiece]+splitPath (Path ps lp es)+    = ps ++ filter isValid [combineLastAndExtensions lp es]++-- | Join path pieces back into a path+--+-- >>> joinPath ["a", "full", "absolute", "directory", "path"] :: Maybe AbsPath+-- Just /a/full/absolute/directory/path+-- >>> joinPath [] :: Maybe RelPath+-- Just .+-- >>> joinPath [] :: Maybe AbsPath+-- Just /+-- >>> joinPath [".", "."] :: Maybe RelPath+-- Nothing+joinPath :: [PathPiece] -> Maybe (Path rel)+joinPath ps =+    case unsnoc ps of+        Nothing -> Just $ emptyPath+        Just (ips, p) ->+            let (lp, es) = splitPiece p+            in constructValid $ Path ips lp es+++--- [ UTILS ] ---++initMay :: [a] -> Maybe [a]+initMay [] = Nothing+initMay as = Just $ reverse $ tail $ reverse as++lastMay :: [a] -> Maybe a+lastMay [] = Nothing+lastMay as = Just $ head $ reverse as++unsnoc :: [a] -> Maybe ([a], a)+unsnoc as = (,) <$> initMay as <*> lastMay as++uncons :: [a] -> Maybe (a, [a])+uncons [] = Nothing+uncons (a:as) = Just (a, as)++isEmptyLastPathPiece :: LastPathPiece -> Bool+isEmptyLastPathPiece = (== emptyLastPathPiece)++emptyLastPathPiece :: LastPathPiece+emptyLastPathPiece = (LastPathPiece T.empty)++emptyPath :: Path rel+emptyPath = (Path [] emptyLastPathPiece [])++isEmptyPath :: Path rel -> Bool+isEmptyPath p = p == emptyPath++renderPiece :: PathPiece -> String+renderPiece (PathPiece p) = T.unpack p++renderLastPiece :: LastPathPiece -> String+renderLastPiece (LastPathPiece p) = T.unpack p++renderExtension :: Extension -> String+renderExtension (Extension e) = T.unpack e++renderExtensions :: [Extension] -> String+renderExtensions [] = []+renderExtensions es = [extensionSeparator]+    ++ intercalate [extensionSeparator] (map renderExtension es)++combineLastAndExtensions :: LastPathPiece -> [Extension] -> PathPiece+combineLastAndExtensions (LastPathPiece lpp) es+    = PathPiece $ lpp <> T.pack (renderExtensions es)++splitPiece :: PathPiece -> (LastPathPiece, [Extension])+splitPiece (PathPiece t) =+    let rawExts = filter (not . T.null) $ T.split (== extensionSeparator) t+    in case uncons rawExts of+        Nothing -> (emptyLastPathPiece, [])+        Just (lastPieceStr, safeExts) ->+            let lastPiece = LastPathPiece lastPieceStr+                exts = map Extension safeExts+            in (lastPiece, exts)++unsafePathTypeCoerse :: Path rel -> Path rel'+unsafePathTypeCoerse (Path pieces lastPiece exts) = Path pieces lastPiece exts+
+ test/DocTest.hs view
@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "-XOverloadedStrings", "src/Data/Path/Internal.hs"]