Julian Ospald
d15e4b8ad9
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
226 lines
7.3 KiB
Haskell
226 lines
7.3 KiB
Haskell
{-# 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
|