Clean up, rewrite stuff
This commit is contained in:
Julian Ospald
parent
577ecf6750
commit
7e8c745e35
71
README.md
71
README.md
|
|
@ -16,65 +16,14 @@ decided to fork it.
|
|||
|
||||
## Differences to 'path'
|
||||
|
||||
I wasn't happy with the way it dealt with Dir vs File things. In his
|
||||
version of the library, a `Path b Dir` always ends with a trailing
|
||||
path separator and `Path b File` never ends with a trailing path separator.
|
||||
|
||||
IMO, it is nonsensical to make a Dir vs File distinction on path level,
|
||||
although it first seems nice.
|
||||
Some of the reasons are:
|
||||
* a path is just that: a path. It is completely disconnected from IO level
|
||||
and even if a `Dir`/`File` type theoretically allows us to say "this path
|
||||
ought to point to a file", there is literally zero guarantee that it will
|
||||
hold true at runtime. So this basically gives a false feeling of a
|
||||
type-safe file distinction.
|
||||
* it's imprecise about Dir vs File distinction, which makes it even worse,
|
||||
because a directory is also a file (just not a regular file). Add symlinks
|
||||
to that and the confusion is complete.
|
||||
* it makes the API oddly complicated for use cases where we basically don't
|
||||
care (yet) whether something turns out to be a directory or not
|
||||
|
||||
Still, it comes also with a few perks:
|
||||
* it simplifies some functions, because they now have guarantees whether a
|
||||
path ends in a trailing path separator or not
|
||||
* it may be safer for interaction with other library functions, which behave
|
||||
differently depending on a trailing path separator (like probably shelly)
|
||||
|
||||
Not limited to, but also in order to fix my remarks without breaking any
|
||||
benefits, I did:
|
||||
* rename the `Dir`/`File` types to `TPS`/`NoTPS`, so it's clear we are only
|
||||
giving information about trailing path separators and not actual file
|
||||
types we don't know about yet
|
||||
* add a `MaybeTPS` type, which does not mess with trailing path separators
|
||||
and also gives no guarantees about them... then added `toNoTPS` and
|
||||
`toTPS` to allow type-safe conversion
|
||||
* make some functions accept more general types, so we don't unnecessarily
|
||||
force paths with trailing separators for `(</>)` for example... instead
|
||||
these functions now examine the paths to still have correct behavior.
|
||||
This is really minor overhead. You might say now "but then I can append
|
||||
filepath to filepath". Well, as I said... we don't know whether it's a
|
||||
"filepath" at all.
|
||||
* merge `filename` and `dirname` into `basename` and make `parent` be
|
||||
`dirname`, so the function names match the name of the POSIX ones,
|
||||
which do (almost) the same...
|
||||
* fix a bug in `basename` (formerly `dirname`) which broke the type
|
||||
guarantees
|
||||
* add a pattern synonym for easier pattern matching without exporting
|
||||
the internal Path constructor
|
||||
|
||||
## Consequences
|
||||
|
||||
So what does that mean? Well, it means that this library does not and
|
||||
cannot make any guarantees about what a filepath is meant for or what
|
||||
it might point to. And it doesn't pretend it can.
|
||||
|
||||
So when you strip the trailing path separator of a path that points to a
|
||||
directory and then shove it into some function which expects a regular
|
||||
file... then that function will very likely blow up. That's the nature of IO.
|
||||
There is no type that can save you from interfacing such low-level libraries.
|
||||
The filesystem is in constant change. What might have been a regular file
|
||||
2 seconds ago, can now be a directory or a symlink.
|
||||
That means you need a proper File type that is tied to your IO code.
|
||||
This is what [hsfm](https://github.com/hasufell/hsfm) does. It currently
|
||||
is not a library, maybe it will be in the future.
|
||||
* doesn't attempt to fake IO-related types into the path, so whether a path points to a file or directory is up to your IO-code to decide... this should be a library that is used _with_ a proper IO File Type
|
||||
* trailing path separators will be preserved if they exist, no messing with that
|
||||
* uses safe ByteString for filepaths under the hood instead of unsafe String
|
||||
* fixes broken [dirname](https://github.com/chrisdone/path/issues/18)
|
||||
* renames dirname/filename to basename/dirname to match the POSIX shell functions
|
||||
* introduces a new `Path Fn` for safe filename guarantees and a `RelC` class
|
||||
* allows pattern matching via unidirectional PatternSynonym
|
||||
* uses simple doctest for testing
|
||||
* allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME`
|
||||
* remove TH, it sucks
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,14 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Test.DocTest
|
||||
import Test.HUnit
|
||||
|
||||
main =
|
||||
doctest
|
||||
[ "-isrc"
|
||||
, "-XOverloadedStrings"
|
||||
, "src/HPath.hs"
|
||||
]
|
||||
|
||||
35
hpath.cabal
35
hpath.cabal
|
|
@ -15,25 +15,30 @@ extra-source-files: README.md, CHANGELOG
|
|||
library
|
||||
hs-source-dirs: src/
|
||||
ghc-options: -Wall -O2
|
||||
exposed-modules: HPath, HPath.Foreign, HPath.Internal
|
||||
exposed-modules: HPath, HPath.Internal
|
||||
build-depends: base >= 4 && <5
|
||||
, HUnit
|
||||
, bytestring
|
||||
, encoding
|
||||
, exceptions
|
||||
, deepseq
|
||||
, exceptions
|
||||
, hspec
|
||||
, posix-paths
|
||||
, utf8-string
|
||||
, word8
|
||||
, template-haskell
|
||||
|
||||
test-suite test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
hs-source-dirs: test
|
||||
build-depends: HUnit
|
||||
, base
|
||||
, hspec
|
||||
, mtl
|
||||
, hpath
|
||||
|
||||
test-suite doctests
|
||||
type: exitcode-stdio-1.0
|
||||
ghc-options: -threaded
|
||||
main-is: doctests.hs
|
||||
build-depends: base
|
||||
, HUnit
|
||||
, bytestring
|
||||
, doctest >= 0.8
|
||||
, hpath
|
||||
, posix-paths
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/hasufell/hpath
|
||||
type: git
|
||||
location: https://github.com/hasufell/hpath
|
||||
|
||||
|
|
|
|||
511
src/HPath.hs
511
src/HPath.hs
|
|
@ -10,12 +10,10 @@
|
|||
-- Support for well-typed paths.
|
||||
|
||||
|
||||
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
module HPath
|
||||
|
|
@ -32,16 +30,11 @@ module HPath
|
|||
,parseAbs
|
||||
,parseFn
|
||||
,parseRel
|
||||
-- * Path Constructors
|
||||
,mkAbs
|
||||
,mkFn
|
||||
,mkRel
|
||||
-- * Path Conversion
|
||||
,canonicalizePath
|
||||
,fromAbs
|
||||
,fromRel
|
||||
,normalize
|
||||
,normalizeAbs
|
||||
,toFilePath
|
||||
-- * Path Operations
|
||||
,(</>)
|
||||
|
|
@ -61,52 +54,38 @@ module HPath
|
|||
,combine
|
||||
,dropFileName
|
||||
,dropTrailingPathSeparator
|
||||
,dropWhileEnd
|
||||
,equalFilePath
|
||||
,fpToString
|
||||
,joinPath
|
||||
,normalise
|
||||
,splitDirectories
|
||||
,splitFileName
|
||||
,splitPath
|
||||
,stripPrefix
|
||||
,takeDirectory
|
||||
,userStringToFP
|
||||
-- * ByteString Query functions
|
||||
,hiddenFile
|
||||
-- * Queries
|
||||
,hasDot
|
||||
,hasDoublePS
|
||||
,hasLeadingPathSeparator
|
||||
,hasParentDir
|
||||
,hasTrailingPathSeparator
|
||||
,isAbsolute
|
||||
,isFileName
|
||||
,isRelative
|
||||
,isValid
|
||||
-- * String based functions
|
||||
,realPath
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception (Exception)
|
||||
import Control.Monad(void)
|
||||
import Control.Monad.Catch (MonadThrow(..))
|
||||
import Data.ByteString(ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (fromString, toString)
|
||||
import Data.Data
|
||||
import Data.Encoding(decodeStrictByteString, encodeStrictByteString)
|
||||
import Data.Encoding.UTF8(UTF8(..))
|
||||
import qualified Data.List as L
|
||||
import Data.Maybe
|
||||
import Data.Word8
|
||||
import Foreign.C.Error
|
||||
import Foreign.C.String
|
||||
import Foreign.Marshal.Alloc(allocaBytes)
|
||||
import HPath.Foreign
|
||||
import HPath.Internal
|
||||
import Language.Haskell.TH
|
||||
import Safe(initDef)
|
||||
import System.Posix.FilePath hiding ((</>))
|
||||
import System.Posix.Directory.Traversals(realpath)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -147,10 +126,24 @@ pattern Path x <- (MkPath x)
|
|||
|
||||
|
||||
|
||||
-- | Get a location for an absolute path.
|
||||
-- | Get a location for an absolute path. Produces a normalised path.
|
||||
--
|
||||
-- Throws: 'PathParseException'
|
||||
--
|
||||
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
|
||||
-- Just "/abc"
|
||||
-- >>> parseAbs "/" :: Maybe (Path Abs)
|
||||
-- Just "/"
|
||||
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
|
||||
-- Just "/abc/def"
|
||||
-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)
|
||||
-- Just "/abc/def/"
|
||||
-- >>> parseAbs "abc" :: Maybe (Path Abs)
|
||||
-- Nothing
|
||||
-- >>> parseAbs "" :: Maybe (Path Abs)
|
||||
-- Nothing
|
||||
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
|
||||
-- Nothing
|
||||
parseAbs :: MonadThrow m
|
||||
=> ByteString -> m (Path Abs)
|
||||
parseAbs filepath =
|
||||
|
|
@ -160,14 +153,33 @@ parseAbs filepath =
|
|||
then return (MkPath $ normalise filepath)
|
||||
else throwM (InvalidAbs filepath)
|
||||
|
||||
-- | Get a location for a relative path. Produces a normalized
|
||||
-- path which always ends in a path separator.
|
||||
|
||||
-- | Get a location for a relative path. Produces a normalised
|
||||
-- path.
|
||||
--
|
||||
-- Note that @filepath@ may contain any number of @./@ but may not consist
|
||||
-- solely of @./@. It also may not contain a single @..@ anywhere.
|
||||
--
|
||||
-- Throws: 'PathParseException'
|
||||
--
|
||||
-- >>> parseRel "abc" :: Maybe (Path Rel)
|
||||
-- Just "abc"
|
||||
-- >>> parseRel "def/" :: Maybe (Path Rel)
|
||||
-- Just "def/"
|
||||
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
|
||||
-- Just "abc/def"
|
||||
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
|
||||
-- Just "abc/def/"
|
||||
-- >>> parseRel "/abc" :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
-- >>> parseRel "" :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
-- >>> parseRel "." :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
-- >>> parseRel ".." :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
parseRel :: MonadThrow m
|
||||
=> ByteString -> m (Path Rel)
|
||||
parseRel filepath =
|
||||
|
|
@ -184,6 +196,26 @@ parseRel filepath =
|
|||
--
|
||||
-- Throws: 'PathParseException'
|
||||
--
|
||||
-- >>> parseFn "abc" :: Maybe (Path Fn)
|
||||
-- Just "abc"
|
||||
-- >>> parseFn "..." :: Maybe (Path Fn)
|
||||
-- Just "..."
|
||||
-- >>> parseFn "def/" :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn "abc/def" :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn "abc/def/." :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn "/abc" :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn "" :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn "abc/../foo" :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn "." :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
-- >>> parseFn ".." :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
parseFn :: MonadThrow m
|
||||
=> ByteString -> m (Path Fn)
|
||||
parseFn filepath =
|
||||
|
|
@ -195,46 +227,10 @@ parseFn filepath =
|
|||
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Constructors
|
||||
|
||||
-- | Make a 'Path Abs TPS'.
|
||||
--
|
||||
-- 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).
|
||||
mkAbs :: ByteString -> Q Exp
|
||||
mkAbs s =
|
||||
case parseAbs s of
|
||||
Left err -> error (show err)
|
||||
Right (MkPath str) ->
|
||||
[|MkPath $(return (LitE (StringL (show str)))) :: Path Abs|]
|
||||
|
||||
-- | Make a 'Path Rel TPS'.
|
||||
mkRel :: ByteString -> Q Exp
|
||||
mkRel s =
|
||||
case parseRel s of
|
||||
Left err -> error (show err)
|
||||
Right (MkPath str) ->
|
||||
[|MkPath $(return (LitE (StringL (show str)))) :: Path Rel|]
|
||||
|
||||
-- | Make a 'Path Rel TPS'.
|
||||
mkFn :: ByteString -> Q Exp
|
||||
mkFn s =
|
||||
case parseFn s of
|
||||
Left err -> error (show err)
|
||||
Right (MkPath str) ->
|
||||
[|MkPath $(return (LitE (StringL (show str)))) :: Path Fn|]
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Path Conversion
|
||||
|
||||
-- | Convert to a ByteString type.
|
||||
--
|
||||
-- All TPS data types have a trailing slash, so if you want no trailing
|
||||
-- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from
|
||||
-- the filepath package.
|
||||
toFilePath :: Path b -> ByteString
|
||||
toFilePath (MkPath l) = l
|
||||
|
||||
|
|
@ -247,16 +243,10 @@ fromRel = toFilePath
|
|||
normalize :: Path t -> Path t
|
||||
normalize (MkPath l) = MkPath $ normalise l
|
||||
|
||||
-- | A variant for `normalize` for absolute paths which
|
||||
-- also removes occurences of '..', which may behave
|
||||
-- strange for symlinks though.
|
||||
normalizeAbs :: Path Abs -> Path Abs
|
||||
normalizeAbs (MkPath l) = MkPath . fromJust . normaliseAbs $ l
|
||||
|
||||
-- | May fail on `realPath`.
|
||||
-- | May fail on `realpath`.
|
||||
canonicalizePath :: Path Abs -> IO (Path Abs)
|
||||
canonicalizePath (MkPath l) = do
|
||||
nl <- realPath l
|
||||
nl <- realpath l
|
||||
return $ MkPath nl
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -270,22 +260,43 @@ canonicalizePath (MkPath l) = do
|
|||
-- Technically, the first argument can be a path that points to a non-directory,
|
||||
-- because this library is IO-agnostic and makes no assumptions about
|
||||
-- file types.
|
||||
--
|
||||
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
|
||||
-- "/file"
|
||||
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
|
||||
-- "/path/to/file"
|
||||
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
|
||||
-- "/file/lal"
|
||||
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
|
||||
-- "/file/"
|
||||
(</>) :: RelC r => Path b -> Path r -> Path b
|
||||
(</>) (MkPath a) (MkPath b) = MkPath (a' `B.append` b)
|
||||
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
|
||||
where
|
||||
a' = addTrailingPathSeparator a
|
||||
a' = if BS.last a == pathSeparator
|
||||
then a
|
||||
else addTrailingPathSeparator a
|
||||
|
||||
-- | Strip directory from path, making it relative to that directory.
|
||||
-- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.
|
||||
--
|
||||
-- The bases must match.
|
||||
--
|
||||
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
|
||||
-- Just "fad"
|
||||
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
|
||||
-- Just "fad"
|
||||
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
|
||||
-- Nothing
|
||||
stripDir :: MonadThrow m
|
||||
=> Path b -> Path b -> m (Path Rel)
|
||||
stripDir (MkPath p) (MkPath l) =
|
||||
case stripPrefix p' l of
|
||||
Nothing -> throwM (Couldn'tStripPrefixTPS p' l)
|
||||
Just ok -> if B.null ok
|
||||
Just ok -> if BS.null ok
|
||||
then throwM (Couldn'tStripPrefixTPS p' l)
|
||||
else return (MkPath ok)
|
||||
where
|
||||
|
|
@ -293,10 +304,27 @@ stripDir (MkPath p) (MkPath l) =
|
|||
|
||||
-- | Is p a parent of the given location? Implemented in terms of
|
||||
-- 'stripDir'. The bases must match.
|
||||
--
|
||||
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
|
||||
-- True
|
||||
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
|
||||
-- True
|
||||
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
|
||||
-- False
|
||||
-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")
|
||||
-- False
|
||||
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
|
||||
-- False
|
||||
isParentOf :: Path b -> Path b -> Bool
|
||||
isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
|
||||
|
||||
|
||||
-- |Get all parents of a path.
|
||||
--
|
||||
-- >>> getAllParents (MkPath "/abs/def/dod")
|
||||
-- ["/abs/def","/abs","/"]
|
||||
-- >>> getAllParents (MkPath "/")
|
||||
-- []
|
||||
getAllParents :: Path Abs -> [Path Abs]
|
||||
getAllParents (MkPath p)
|
||||
| np == pathSeparator' = []
|
||||
|
|
@ -311,6 +339,10 @@ getAllParents (MkPath p)
|
|||
--
|
||||
-- @dirname (p \<\/> a) == dirname p@
|
||||
--
|
||||
-- >>> dirname (MkPath "/abc/def/dod")
|
||||
-- "/abc/def"
|
||||
-- >>> dirname (MkPath "/")
|
||||
-- "/"
|
||||
dirname :: Path Abs -> Path Abs
|
||||
dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
|
||||
|
||||
|
|
@ -322,6 +354,11 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
|
|||
-- @basename (p \<\/> a) == basename a@
|
||||
--
|
||||
-- Throws: `PathException` if given the root path "/"
|
||||
--
|
||||
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
|
||||
-- Just "dod"
|
||||
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
|
||||
-- Nothing
|
||||
basename :: MonadThrow m => Path b -> m (Path Fn)
|
||||
basename (MkPath l)
|
||||
| not (isAbsolute rl) = return $ MkPath rl
|
||||
|
|
@ -333,21 +370,31 @@ basename (MkPath l)
|
|||
--------------------------------------------------------------------------------
|
||||
-- ByteString Query functions
|
||||
|
||||
|
||||
-- | Whether the file is a hidden file.
|
||||
--
|
||||
-- >>> hiddenFile (MkPath ".foo")
|
||||
-- True
|
||||
-- >>> hiddenFile (MkPath "..foo.bar")
|
||||
-- True
|
||||
-- >>> hiddenFile (MkPath "...")
|
||||
-- True
|
||||
-- >>> hiddenFile (MkPath "dod")
|
||||
-- False
|
||||
-- >>> hiddenFile (MkPath "dod.bar")
|
||||
-- False
|
||||
hiddenFile :: Path Fn -> Bool
|
||||
hiddenFile (MkPath fp)
|
||||
| fp == pathDoubleDot = False
|
||||
| fp == pathDot' = False
|
||||
| otherwise = pathDot' `B.isPrefixOf` fp
|
||||
| otherwise = pathDot' `BS.isPrefixOf` fp
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- ByteString/Word8 constants
|
||||
|
||||
pathSeparator :: Word8
|
||||
pathSeparator = _slash
|
||||
|
||||
pathSeparator' :: ByteString
|
||||
pathSeparator' = B.singleton pathSeparator
|
||||
pathSeparator' = BS.singleton pathSeparator
|
||||
|
||||
|
||||
pathDot :: Word8
|
||||
|
|
@ -355,11 +402,11 @@ pathDot = _period
|
|||
|
||||
|
||||
pathDot' :: ByteString
|
||||
pathDot' = B.singleton pathDot
|
||||
pathDot' = BS.singleton pathDot
|
||||
|
||||
|
||||
pathDoubleDot :: ByteString
|
||||
pathDoubleDot = pathDot `B.cons` pathDot'
|
||||
pathDoubleDot = pathDot `BS.cons` pathDot'
|
||||
|
||||
|
||||
nullByte :: Word8
|
||||
|
|
@ -370,228 +417,142 @@ nullByte = _nul
|
|||
-- ByteString Operations
|
||||
|
||||
|
||||
dropWhileEnd :: (Word8 -> Bool) -> ByteString -> ByteString
|
||||
dropWhileEnd p = B.reverse . B.dropWhile p . B.reverse
|
||||
|
||||
|
||||
dropTrailingPathSeparator :: ByteString -> ByteString
|
||||
dropTrailingPathSeparator filepath =
|
||||
if hasTrailingPathSeparator filepath
|
||||
then let filepath' = dropWhileEnd (== pathSeparator) filepath
|
||||
in if B.null filepath' then B.singleton . B.last $ filepath else filepath'
|
||||
else filepath
|
||||
|
||||
|
||||
addTrailingPathSeparator :: ByteString -> ByteString
|
||||
addTrailingPathSeparator filepath
|
||||
| B.null filepath = filepath
|
||||
| filepath == pathSeparator' = filepath
|
||||
| not (hasTrailingPathSeparator filepath)
|
||||
= filepath `B.append` pathSeparator'
|
||||
| otherwise = filepath
|
||||
|
||||
|
||||
-- |Normalise a file.
|
||||
--
|
||||
-- >>> normalise "/file/\\test////"
|
||||
-- "/file/\\test/"
|
||||
-- >>> normalise "/file/./test"
|
||||
-- "/file/test"
|
||||
-- >>> normalise "/test/file/../bob/fred/"
|
||||
-- "/test/file/../bob/fred/"
|
||||
-- >>> normalise "../bob/fred/"
|
||||
-- "../bob/fred/"
|
||||
-- >>> normalise "./bob/fred/"
|
||||
-- "bob/fred/"
|
||||
-- >>> normalise "./bob////.fred/./...///./..///#."
|
||||
-- "bob/.fred/.../../#."
|
||||
-- >>> normalise "."
|
||||
-- "."
|
||||
-- >>> normalise "./"
|
||||
-- "./"
|
||||
-- >>> normalise "./."
|
||||
-- "./"
|
||||
-- >>> normalise "/./"
|
||||
-- "/"
|
||||
-- >>> normalise "/"
|
||||
-- "/"
|
||||
-- >>> normalise "bob/fred/."
|
||||
-- "bob/fred/"
|
||||
-- >>> normalise "//home"
|
||||
-- "/home"
|
||||
normalise :: ByteString -> ByteString
|
||||
normalise filepath = result `B.append`
|
||||
(if addPathSeparator then pathSeparator' else B.empty)
|
||||
normalise filepath =
|
||||
result `BS.append`
|
||||
(if addPathSeparator
|
||||
then BS.singleton pathSeparator
|
||||
else BS.empty)
|
||||
where
|
||||
(drv, pth) = splitDrive filepath
|
||||
result = joinDrive' (normaliseDrive drv) (f pth)
|
||||
joinDrive' d p
|
||||
| B.null d && B.null p = B.singleton pathDot
|
||||
| otherwise = joinDrive d p
|
||||
addPathSeparator = isDirPath pth && not (hasTrailingPathSeparator result)
|
||||
isDirPath xs = hasTrailingPathSeparator xs
|
||||
|| not (B.null xs) && B.last xs == pathDot
|
||||
&& hasTrailingPathSeparator (B.init xs)
|
||||
normaliseDrive p
|
||||
| B.null p = B.empty
|
||||
| otherwise = B.singleton pathSeparator
|
||||
result = let n = f filepath
|
||||
in if BS.null n
|
||||
then BS.singleton _period
|
||||
else n
|
||||
addPathSeparator = isDirPath filepath &&
|
||||
not (hasTrailingPathSeparator' result)
|
||||
isDirPath xs = hasTrailingPathSeparator' xs
|
||||
|| not (BS.null xs) && BS.last xs == _period
|
||||
&& hasTrailingPathSeparator' (BS.init xs)
|
||||
f = joinPath . dropDots . propSep . splitDirectories
|
||||
propSep :: [ByteString] -> [ByteString]
|
||||
propSep (x:xs)
|
||||
| B.all (== pathSeparator) x = pathSeparator' : xs
|
||||
| otherwise = x : xs
|
||||
| BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs
|
||||
| otherwise = x : xs
|
||||
propSep [] = []
|
||||
dropDots = filter (pathDot' /=)
|
||||
dropDots :: [ByteString] -> [ByteString]
|
||||
dropDots = filter (BS.singleton _period /=)
|
||||
hasTrailingPathSeparator' :: RawFilePath -> Bool
|
||||
hasTrailingPathSeparator' x
|
||||
| BS.null x = False
|
||||
| otherwise = isPathSeparator $ BS.last x
|
||||
|
||||
|
||||
-- | A variant of `normalise` for absolute paths, which removes
|
||||
-- occurences of '..'. If a non-absolute path is passed, returns Nothing.
|
||||
normaliseAbs :: ByteString -> Maybe ByteString
|
||||
normaliseAbs filepath
|
||||
| isRelative filepath = Nothing
|
||||
| otherwise =
|
||||
let nfp = normalise filepath
|
||||
in Just . joinPath . L.foldl' rmDbl [] . splitDirectories $ nfp
|
||||
where
|
||||
rmDbl x y
|
||||
| x == [pathSeparator'] && y == pathDoubleDot = [pathSeparator']
|
||||
| y == pathDoubleDot = initDef [] x
|
||||
| otherwise = x ++ [y]
|
||||
|
||||
|
||||
splitPath :: ByteString -> [ByteString]
|
||||
splitPath filepath = [drv | drv /= B.empty] ++ f pth
|
||||
where
|
||||
(drv, pth) = splitDrive filepath
|
||||
f p
|
||||
| B.null p = []
|
||||
| otherwise = (a `B.append` c) : f d
|
||||
where
|
||||
(a, b) = B.break (== pathSeparator) p
|
||||
(c, d) = splitDrive b
|
||||
|
||||
|
||||
joinPath :: [ByteString] -> ByteString
|
||||
joinPath = foldr combine B.empty
|
||||
|
||||
|
||||
splitDrive :: ByteString -> (ByteString, ByteString)
|
||||
splitDrive = B.span (== pathSeparator)
|
||||
|
||||
|
||||
joinDrive :: ByteString -> ByteString -> ByteString
|
||||
joinDrive = combineAlways
|
||||
|
||||
|
||||
splitDirectories :: ByteString -> [ByteString]
|
||||
splitDirectories = map dropTrailingPathSeparator . splitPath
|
||||
|
||||
|
||||
combine :: ByteString -> ByteString -> ByteString
|
||||
combine d p
|
||||
| hasLeadingPathSeparator p = p
|
||||
| otherwise = combineAlways d p
|
||||
|
||||
|
||||
combineAlways :: ByteString -> ByteString -> ByteString
|
||||
combineAlways d p
|
||||
| B.null d = p
|
||||
| B.null p = d
|
||||
| hasTrailingPathSeparator d = d `B.append` p
|
||||
| otherwise = d `B.append` B.singleton pathSeparator `B.append` p
|
||||
|
||||
|
||||
takeDirectory :: ByteString -> ByteString
|
||||
takeDirectory = dropTrailingPathSeparator . dropFileName
|
||||
|
||||
|
||||
dropFileName :: ByteString -> ByteString
|
||||
dropFileName = fst . splitFileName
|
||||
|
||||
|
||||
splitFileName :: ByteString -> (ByteString, ByteString)
|
||||
splitFileName filepath = (if B.null dir
|
||||
then pathDot `B.cons` pathSeparator'
|
||||
else dir
|
||||
, name)
|
||||
where
|
||||
(dir, name) = splitFileName_ filepath
|
||||
splitFileName_ p = (drv `B.append` dir', file)
|
||||
where
|
||||
(drv, pth) = splitDrive p
|
||||
(dir', file) = B.breakEnd (== pathSeparator) pth
|
||||
|
||||
|
||||
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
|
||||
stripPrefix a b = B.pack `fmap` L.stripPrefix (B.unpack a) (B.unpack b)
|
||||
|
||||
|
||||
-- |Uses UTF-8 decoding to convert the bytestring into a String.
|
||||
fpToString :: ByteString -> String
|
||||
fpToString = decodeStrictByteString UTF8
|
||||
fpToString = toString
|
||||
|
||||
|
||||
-- |Uses UTF-8 encoding to convert a user provided String into
|
||||
-- a ByteString, which represents a filepath.
|
||||
userStringToFP :: String -> ByteString
|
||||
userStringToFP = encodeStrictByteString UTF8
|
||||
userStringToFP = fromString
|
||||
|
||||
|
||||
#if MIN_VERSION_bytestring(0,10,8)
|
||||
#else
|
||||
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
|
||||
stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)
|
||||
#endif
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- ByteString Query functions
|
||||
|
||||
-- | Helper function: check if the filepath has any parent directories in it.
|
||||
--
|
||||
-- >>> hasParentDir "/.."
|
||||
-- True
|
||||
-- >>> hasParentDir "foo/bar/.."
|
||||
-- True
|
||||
-- >>> hasParentDir "foo/../bar/."
|
||||
-- True
|
||||
-- >>> hasParentDir "foo/bar"
|
||||
-- False
|
||||
-- >>> hasParentDir "foo"
|
||||
-- False
|
||||
-- >>> hasParentDir ""
|
||||
-- False
|
||||
-- >>> hasParentDir ".."
|
||||
-- False
|
||||
hasParentDir :: ByteString -> Bool
|
||||
hasParentDir filepath =
|
||||
((pathSeparator `B.cons` pathDoubleDot) `B.isSuffixOf` filepath) ||
|
||||
((pathSeparator' `B.append` pathDoubleDot `B.append` pathSeparator')
|
||||
`B.isInfixOf` filepath) ||
|
||||
((pathDoubleDot `B.append` pathSeparator') `B.isPrefixOf` filepath)
|
||||
|
||||
hasDot :: ByteString -> Bool
|
||||
hasDot filepath =
|
||||
((pathSeparator `B.cons` pathDot') `B.isSuffixOf` filepath) ||
|
||||
((pathSeparator' `B.append` pathDot' `B.append` pathSeparator')
|
||||
`B.isInfixOf` filepath) ||
|
||||
((pathDot `B.cons` pathSeparator') `B.isPrefixOf` filepath)
|
||||
|
||||
hasDoublePS :: ByteString -> Bool
|
||||
hasDoublePS filepath =
|
||||
((pathSeparator `B.cons` pathSeparator') `B.isInfixOf` filepath)
|
||||
|
||||
|
||||
hasTrailingPathSeparator :: ByteString -> Bool
|
||||
hasTrailingPathSeparator filepath
|
||||
| B.null filepath = False
|
||||
| B.last filepath == pathSeparator = True
|
||||
| otherwise = False
|
||||
|
||||
|
||||
hasLeadingPathSeparator :: ByteString -> Bool
|
||||
hasLeadingPathSeparator filepath
|
||||
| B.null filepath = False
|
||||
| B.head filepath == pathSeparator = True
|
||||
| otherwise = False
|
||||
((pathSeparator `BS.cons` pathDoubleDot) `BS.isSuffixOf` filepath) ||
|
||||
((pathSeparator' `BS.append` pathDoubleDot `BS.append` pathSeparator')
|
||||
`BS.isInfixOf` filepath) ||
|
||||
((pathDoubleDot `BS.append` pathSeparator') `BS.isPrefixOf` filepath)
|
||||
|
||||
|
||||
-- | Is the given filename a valid filename?
|
||||
--
|
||||
-- >>> isFileName "lal"
|
||||
-- True
|
||||
-- >>> isFileName "."
|
||||
-- True
|
||||
-- >>> isFileName ".."
|
||||
-- True
|
||||
-- >>> isFileName ""
|
||||
-- False
|
||||
-- >>> isFileName "\0"
|
||||
-- False
|
||||
-- >>> isFileName "/random_ path:*"
|
||||
-- False
|
||||
isFileName :: ByteString -> Bool
|
||||
isFileName filepath =
|
||||
not (pathSeparator' `B.isInfixOf` filepath) &&
|
||||
not (B.null filepath) &&
|
||||
not (nullByte `B.elem` filepath)
|
||||
not (pathSeparator' `BS.isInfixOf` filepath) &&
|
||||
not (BS.null filepath) &&
|
||||
not (nullByte `BS.elem` filepath)
|
||||
|
||||
|
||||
isAbsolute :: ByteString -> Bool
|
||||
isAbsolute filepath
|
||||
| B.null filepath = False
|
||||
| B.head filepath == pathSeparator = True
|
||||
| otherwise = False
|
||||
|
||||
|
||||
isRelative :: ByteString -> Bool
|
||||
isRelative = not . isAbsolute
|
||||
|
||||
|
||||
isValid :: ByteString -> Bool
|
||||
isValid filepath
|
||||
| B.null filepath = False
|
||||
| nullByte `B.elem` filepath = False
|
||||
| otherwise = True
|
||||
|
||||
|
||||
equalFilePath :: ByteString -> ByteString -> Bool
|
||||
equalFilePath p1 p2 = f p1 == f p2
|
||||
where
|
||||
f x = dropTrailingPathSeparator $ normalise x
|
||||
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- String based path functions
|
||||
|
||||
foreign import ccall "realpath"
|
||||
c_realpath :: CString -> CString -> IO CString
|
||||
|
||||
-- | return the canonicalized absolute pathname
|
||||
-- | Is a FilePath valid, i.e. could you create a file like it?
|
||||
--
|
||||
-- like canonicalizePath, but uses realpath(3)
|
||||
realPath :: ByteString -> IO ByteString
|
||||
realPath inp =
|
||||
allocaBytes pathMax $ \tmp -> do
|
||||
void $ B.useAsCString inp
|
||||
$ \cstr -> throwErrnoIfNull "realpath"
|
||||
$ c_realpath cstr tmp
|
||||
B.packCString tmp
|
||||
-- >>> isValid ""
|
||||
-- False
|
||||
-- >>> isValid "\0"
|
||||
-- False
|
||||
-- >>> isValid "/random_ path:*"
|
||||
-- True
|
||||
isValid :: RawFilePath -> Bool
|
||||
isValid filepath
|
||||
| BS.null filepath = False
|
||||
| _nul `BS.elem` filepath = False
|
||||
| otherwise = True
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +0,0 @@
|
|||
module HPath.Foreign where
|
||||
|
||||
#include <limits.h>
|
||||
|
||||
pathMax :: Int
|
||||
pathMax = #{const PATH_MAX}
|
||||
|
||||
225
test/Main.hs
225
test/Main.hs
|
|
@ -1,225 +0,0 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
-- | Test suite.
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import HPath
|
||||
import HPath.Internal
|
||||
import Test.Hspec
|
||||
|
||||
-- | Test suite entry point, returns exit failure if any test fails.
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
-- | Test suite.
|
||||
spec :: Spec
|
||||
spec =
|
||||
do describe "Parsing: Path Abs Dir" parseAbsTPSSpec
|
||||
describe "Parsing: Path Rel Dir" parseRelTPSSpec
|
||||
describe "Parsing: Path Abs File" parseAbsNoTPSSpec
|
||||
describe "Parsing: Path Rel File" parseRelNoTPSSpec
|
||||
describe "Operations: (</>)" operationAppend
|
||||
describe "Operations: stripDir" operationStripDir
|
||||
describe "Operations: isParentOf" operationIsParentOf
|
||||
describe "Operations: dirname" operationDirname
|
||||
describe "Operations: basename" operationBasename
|
||||
describe "Restrictions" restrictions
|
||||
|
||||
-- | Restricting the input of any tricks.
|
||||
restrictions :: Spec
|
||||
restrictions =
|
||||
do parseFails "~/"
|
||||
parseFails "~/foo"
|
||||
parseFails "~/foo/bar"
|
||||
parseFails "../"
|
||||
parseFails ".."
|
||||
parseFails "."
|
||||
parseFails "/.."
|
||||
parseFails "/foo/../bar/"
|
||||
parseFails "/foo/bar/.."
|
||||
where parseFails x =
|
||||
it (show x ++ " should be rejected")
|
||||
(isNothing (void (parseAbsTPS x) <|>
|
||||
void (parseRelTPS x) <|>
|
||||
void (parseAbsNoTPS x) <|>
|
||||
void (parseRelNoTPS x)))
|
||||
|
||||
-- | The 'basename' operation.
|
||||
operationBasename :: Spec
|
||||
operationBasename =
|
||||
do it "basename ($(mkAbsTPS parent) </> basename $(mkRelNoTPS filename)) == $(mkRelNoTPS filename)"
|
||||
((basename =<< ($(mkAbsTPS "/home/hasufell/") </>)
|
||||
<$> basename $(mkRelNoTPS "bar.txt")) ==
|
||||
Just $(mkRelNoTPS "bar.txt"))
|
||||
it "basename ($(mkRelTPS parent) </> basename $(mkRelNoTPS filename)) == $(mkRelNoTPS filename)"
|
||||
((basename =<< ($(mkRelTPS "home/hasufell/") </>)
|
||||
<$> basename $(mkRelNoTPS "bar.txt")) ==
|
||||
Just $(mkRelNoTPS "bar.txt"))
|
||||
|
||||
-- | The 'dirname' operation.
|
||||
operationDirname :: Spec
|
||||
operationDirname =
|
||||
do it "dirname (parent </> child) == parent"
|
||||
(dirname ($(mkAbsTPS "/foo") </>
|
||||
$(mkRelTPS "bar")) ==
|
||||
$(mkAbsTPS "/foo"))
|
||||
it "dirname \"\" == \"\""
|
||||
(dirname $(mkAbsTPS "/") ==
|
||||
$(mkAbsTPS "/"))
|
||||
it "dirname (parent \"\") == \"\""
|
||||
(dirname (dirname $(mkAbsTPS "/")) ==
|
||||
$(mkAbsTPS "/"))
|
||||
|
||||
-- | The 'isParentOf' operation.
|
||||
operationIsParentOf :: Spec
|
||||
operationIsParentOf =
|
||||
do it "isParentOf parent (parent </> child)"
|
||||
(isParentOf
|
||||
$(mkAbsTPS "///bar/")
|
||||
($(mkAbsTPS "///bar/") </>
|
||||
$(mkRelNoTPS "bar/foo.txt")))
|
||||
it "isParentOf parent (parent </> child)"
|
||||
(isParentOf
|
||||
$(mkRelTPS "bar/")
|
||||
($(mkRelTPS "bar/") </>
|
||||
$(mkRelNoTPS "bob/foo.txt")))
|
||||
|
||||
-- | The 'stripDir' operation.
|
||||
operationStripDir :: Spec
|
||||
operationStripDir =
|
||||
do it "stripDir parent (parent </> child) = child"
|
||||
(stripDir $(mkAbsTPS "///bar/")
|
||||
($(mkAbsTPS "///bar/") </>
|
||||
$(mkRelNoTPS "bar/foo.txt")) ==
|
||||
Just $(mkRelNoTPS "bar/foo.txt"))
|
||||
it "stripDir parent (parent </> child) = child"
|
||||
(stripDir $(mkRelTPS "bar/")
|
||||
($(mkRelTPS "bar/") </>
|
||||
$(mkRelNoTPS "bob/foo.txt")) ==
|
||||
Just $(mkRelNoTPS "bob/foo.txt"))
|
||||
it "stripDir parent parent = _|_"
|
||||
(stripDir $(mkAbsTPS "/home/hasufell/foo")
|
||||
$(mkAbsTPS "/home/hasufell/foo") ==
|
||||
Nothing)
|
||||
|
||||
-- | The '</>' operation.
|
||||
operationAppend :: Spec
|
||||
operationAppend =
|
||||
do it "AbsDir + RelDir = AbsDir"
|
||||
($(mkAbsTPS "/home/") </>
|
||||
$(mkRelTPS "hasufell") ==
|
||||
$(mkAbsTPS "/home/hasufell/"))
|
||||
it "AbsDir + RelFile = AbsFile"
|
||||
($(mkAbsTPS "/home/") </>
|
||||
$(mkRelNoTPS "hasufell/test.txt") ==
|
||||
$(mkAbsNoTPS "/home/hasufell/test.txt"))
|
||||
it "RelDir + RelDir = RelDir"
|
||||
($(mkRelTPS "home/") </>
|
||||
$(mkRelTPS "hasufell") ==
|
||||
$(mkRelTPS "home/hasufell"))
|
||||
it "RelDir + RelFile = RelFile"
|
||||
($(mkRelTPS "home/") </>
|
||||
$(mkRelNoTPS "hasufell/test.txt") ==
|
||||
$(mkRelNoTPS "home/hasufell/test.txt"))
|
||||
|
||||
-- | Tests for the tokenizer.
|
||||
parseAbsTPSSpec :: Spec
|
||||
parseAbsTPSSpec =
|
||||
do failing ""
|
||||
failing "./"
|
||||
failing "~/"
|
||||
failing "foo.txt"
|
||||
succeeding "/" (MkPath "/")
|
||||
succeeding "//" (MkPath "/")
|
||||
succeeding "///foo//bar//mu/" (MkPath "/foo/bar/mu/")
|
||||
succeeding "///foo//bar////mu" (MkPath "/foo/bar/mu/")
|
||||
succeeding "///foo//bar/.//mu" (MkPath "/foo/bar/mu/")
|
||||
where failing x = parserTest parseAbsTPS x Nothing
|
||||
succeeding x with = parserTest parseAbsTPS x (Just with)
|
||||
|
||||
-- | Tests for the tokenizer.
|
||||
parseRelTPSSpec :: Spec
|
||||
parseRelTPSSpec =
|
||||
do failing ""
|
||||
failing "/"
|
||||
failing "//"
|
||||
failing "~/"
|
||||
failing "/"
|
||||
failing "./"
|
||||
failing "././"
|
||||
failing "//"
|
||||
failing "///foo//bar//mu/"
|
||||
failing "///foo//bar////mu"
|
||||
failing "///foo//bar/.//mu"
|
||||
succeeding "..." (MkPath ".../")
|
||||
succeeding "foo.bak" (MkPath "foo.bak/")
|
||||
succeeding "./foo" (MkPath "foo/")
|
||||
succeeding "././foo" (MkPath "foo/")
|
||||
succeeding "./foo/./bar" (MkPath "foo/bar/")
|
||||
succeeding "foo//bar//mu//" (MkPath "foo/bar/mu/")
|
||||
succeeding "foo//bar////mu" (MkPath "foo/bar/mu/")
|
||||
succeeding "foo//bar/.//mu" (MkPath "foo/bar/mu/")
|
||||
where failing x = parserTest parseRelTPS x Nothing
|
||||
succeeding x with = parserTest parseRelTPS x (Just with)
|
||||
|
||||
-- | Tests for the tokenizer.
|
||||
parseAbsNoTPSSpec :: Spec
|
||||
parseAbsNoTPSSpec =
|
||||
do failing ""
|
||||
failing "./"
|
||||
failing "~/"
|
||||
failing "./foo.txt"
|
||||
failing "/"
|
||||
failing "//"
|
||||
failing "///foo//bar//mu/"
|
||||
succeeding "/..." (MkPath "/...")
|
||||
succeeding "/foo.txt" (MkPath "/foo.txt")
|
||||
succeeding "///foo//bar////mu.txt" (MkPath "/foo/bar/mu.txt")
|
||||
succeeding "///foo//bar/.//mu.txt" (MkPath "/foo/bar/mu.txt")
|
||||
where failing x = parserTest parseAbsNoTPS x Nothing
|
||||
succeeding x with = parserTest parseAbsNoTPS x (Just with)
|
||||
|
||||
-- | Tests for the tokenizer.
|
||||
parseRelNoTPSSpec :: Spec
|
||||
parseRelNoTPSSpec =
|
||||
do failing ""
|
||||
failing "/"
|
||||
failing "//"
|
||||
failing "~/"
|
||||
failing "/"
|
||||
failing "./"
|
||||
failing "//"
|
||||
failing "///foo//bar//mu/"
|
||||
failing "///foo//bar////mu"
|
||||
failing "///foo//bar/.//mu"
|
||||
succeeding "..." (MkPath "...")
|
||||
succeeding "foo.txt" (MkPath "foo.txt")
|
||||
succeeding "./foo.txt" (MkPath "foo.txt")
|
||||
succeeding "././foo.txt" (MkPath "foo.txt")
|
||||
succeeding "./foo/./bar.txt" (MkPath "foo/bar.txt")
|
||||
succeeding "foo//bar//mu.txt" (MkPath "foo/bar/mu.txt")
|
||||
succeeding "foo//bar////mu.txt" (MkPath "foo/bar/mu.txt")
|
||||
succeeding "foo//bar/.//mu.txt" (MkPath "foo/bar/mu.txt")
|
||||
where failing x = parserTest parseRelNoTPS x Nothing
|
||||
succeeding x with = parserTest parseRelNoTPS x (Just with)
|
||||
|
||||
-- | Parser test.
|
||||
parserTest :: (Show a1,Show a,Eq a1)
|
||||
=> (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()
|
||||
parserTest parser input expected =
|
||||
it ((case expected of
|
||||
Nothing -> "Failing: "
|
||||
Just{} -> "Succeeding: ") <>
|
||||
"Parsing " <>
|
||||
show input <>
|
||||
" " <>
|
||||
case expected of
|
||||
Nothing -> "should fail."
|
||||
Just x -> "should succeed with: " <> show x)
|
||||
(actual == expected)
|
||||
where actual = parser input
|
||||
Loading…
Reference in New Issue