Clean up, rewrite stuff
This commit is contained in:
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
|
||||
Reference in New Issue
Block a user