turtle-1.6.2: test/system-filepath.hs

{-# Language CPP #-}
{-# Options_GHC -Wno-deprecations #-}

module Main (main) where

import Test.Tasty
import Test.Tasty.HUnit
import Turtle

main :: IO ()
main = defaultMain $ testGroup "system-filepath tests"
    [ test_Root
    , test_Directory
    , test_Parent
    , test_CommonPrefix
    , test_StripPrefix
    , test_Collapse
    , test_Filename
    , test_Dirname
    , test_Basename
    , test_Absolute
    , test_Relative
    , test_SplitDirectories
    , test_SplitExtension
    ]

test_Root :: TestTree
test_Root = testCase "root" $ do
    "" @=? root ""
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    "c:\\" @=? root "c:\\"
    "c:\\" @=? root "c:\\foo"
#else
    "/" @=? root "/"
    "/" @=? root "/foo"
#endif
    "" @=? root "foo"

test_Directory :: TestTree
test_Directory = testCase "directory" $ do
    "./" @=? directory ""
    "/" @=? directory "/"
    "/foo/" @=? directory "/foo/bar"
    "/foo/bar/" @=? directory "/foo/bar/"
    "./" @=? directory "."
    "../" @=? directory ".."
    "../" @=? directory "../foo"
    "../foo/" @=? directory "../foo/"
    "./" @=? directory "foo"
    "foo/" @=? directory "foo/bar"

test_Parent :: TestTree
test_Parent = testCase "parent" $ do
    -- The behavior in the presence of `.` / `..` is messed up, but that's how
    -- the old system-filepath package worked, so we're preserving that for
    -- backwards compatibility (for now)
    "./" @=? parent ""
    "./" @=? parent "."
    "./" @=? parent ".."
    "/" @=? parent "/.."
    "/" @=? parent "/."
    "./" @=? parent "./."
    "./" @=? parent "./.."
    "../" @=? parent "../.."
    "../" @=? parent "../."

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    "c:\\" @=? parent "c:\\"
#else
    "/" @=? parent "/"
#endif
    "./" @=? parent "foo"
    "./" @=? parent "./foo"
    "./foo/" @=? parent "foo/bar"
    "./foo/" @=? parent "foo/bar/"
    "./foo/" @=? parent "./foo/bar"
    "/" @=? parent "/foo"
    "/foo/" @=? parent "/foo/bar"

test_Filename :: TestTree
test_Filename = testCase "filename" $ do
    "" @=? filename ""
    "" @=? filename "."
    "" @=? filename ".."
    "" @=? filename "/"
    "" @=? filename "/foo/"
    "bar" @=? filename "/foo/bar"
    "bar.txt" @=? filename "/foo/bar.txt"

test_Dirname :: TestTree
test_Dirname = testCase "dirname" $ do
    "" @=? dirname ""
    "" @=? dirname "/"
    "" @=? dirname "foo"
    ".." @=? dirname ".."
    "foo" @=? dirname "foo/bar"
    "bar" @=? dirname "foo/bar/"
    "bar" @=? dirname "foo/bar/baz.txt"

    -- the directory name will be re-parsed to a file name.
    let dirnameExts q = snd (splitExtensions (dirname q))
    ["d"] @=? dirnameExts "foo.d/bar"

test_Basename :: TestTree
test_Basename = testCase "basename" $ do
    "" @=? basename ".."
    "" @=? basename "/"
    "" @=? basename "."
    ".txt" @=? basename ".txt"
    "foo" @=? basename "foo.txt"
    "bar" @=? basename "foo/bar.txt"

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    "bar" @=? basename "c:\\foo\\bar"
    "bar" @=? basename "c:\\foo\\bar.txt"
#else
    "bar" @=? basename "/foo/bar"
    "bar" @=? basename "/foo/bar.txt"
#endif

test_Absolute :: TestTree
test_Absolute = testCase "absolute" $ do
    let myAssert q = assertBool ("absolute " ++ show q) $ absolute q
    let myAssert' q = assertBool ("not $ absolute " ++ show q) $ not $ absolute q

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    myAssert "c:\\"
    myAssert "c:\\foo\\bar"
    myAssert' ""
    myAssert' "foo\\bar"
    myAssert' "\\foo\\bar"
#else
    myAssert "/"
    myAssert "/foo/bar"
    myAssert' ""
    myAssert' "foo/bar"
#endif


test_Relative :: TestTree
test_Relative = testCase "relative" $ do
    let myAssert q = assertBool ("relative " ++ show q) $ relative q
    let myAssert' q = assertBool ("not $ relative " ++ show q) $ not $ relative q

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    myAssert' "c:\\"
    myAssert' "c:\\foo\\bar"
    myAssert ""
    myAssert "foo\\bar"
#else
    myAssert' "/"
    myAssert' "/foo/bar"
    myAssert ""
    myAssert "foo/bar"
#endif

test_CommonPrefix :: TestTree
test_CommonPrefix = testCase "commonPrefix" $ do
    "" @=? commonPrefix []
    "./" @=? commonPrefix [".", "."]
    "" @=? commonPrefix [".", ".."]
    "foo/" @=? commonPrefix ["foo/bar", "foo/baz"]
    "foo/a.b" @=? commonPrefix ["foo/a.b.c", "foo/a.b.d"]
    "" @=? commonPrefix ["foo/", "bar/"]

test_StripPrefix :: TestTree
test_StripPrefix = testCase "stripPrefix" $ do
    Just "" @=? stripPrefix "" ""
    Just "/" @=? stripPrefix "" "/"
    Just "" @=? stripPrefix "/" "/"
    Just "foo" @=? stripPrefix "/" "/foo"
    Just "foo" @=? stripPrefix "./" "./foo"
    Just "foo.ext" @=? stripPrefix "./" "./foo.ext"
    Just "foo/bar" @=? stripPrefix "/" "/foo/bar"
    Just "bar" @=? stripPrefix "/foo/" "/foo/bar"
    Just "bar/baz" @=? stripPrefix "/foo/" "/foo/bar/baz"
    Just ".txt" @=? stripPrefix "/foo/bar" "/foo/bar.txt"
    Just ".gz" @=? stripPrefix "/foo/bar.txt" "/foo/bar.txt.gz"

    -- Test ignoring non-matching prefixes
    Nothing @=? stripPrefix "/foo" "/foo/bar"
    Nothing @=? stripPrefix "/foo/bar/baz" "/foo"
    Nothing @=? stripPrefix "/foo/baz/" "/foo/bar/qux"
    Nothing @=? stripPrefix "/foo/bar/baz" "/foo/bar/qux"

test_Collapse :: TestTree
test_Collapse = testCase "collapse" $ do
    -- This behavior differs from the old `system-filepath` package, but this
    -- behavior is more correct in the presence of symlinks
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
    "foo\\..\\bar" @=? collapse "foo/../bar"
    "foo\\bar" @=? collapse "foo/bar"
    "foo\\bar" @=? collapse "foo/./bar"
#else
    "foo/../bar" @=? collapse "foo/../bar"
    "foo/bar" @=? collapse "foo/bar"
    "foo/bar" @=? collapse "foo/./bar"
#endif

test_SplitDirectories :: TestTree
test_SplitDirectories = testCase "splitDirectories" $ do
    [] @=? splitDirectories ""
    ["./"] @=? splitDirectories "."
    ["../"] @=? splitDirectories ".."
    ["foo/", "../"] @=? splitDirectories "foo/.."
    ["foo/", "./"] @=? splitDirectories "foo/."
    ["/"] @=? splitDirectories "/"
    ["/", "a"] @=? splitDirectories "/a"
    ["/", "ab/", "cd"] @=? splitDirectories "/ab/cd"
    ["/", "ab/", "cd/"] @=? splitDirectories "/ab/cd/"
    ["ab/", "cd"] @=? splitDirectories "ab/cd"
    ["ab/", "cd/"] @=? splitDirectories "ab/cd/"
    ["ab/", "cd.txt"] @=? splitDirectories "ab/cd.txt"
    ["ab/", "cd/", ".txt"] @=? splitDirectories "ab/cd/.txt"
    ["ab/", "./", "cd"] @=? splitDirectories "ab/./cd"

test_SplitExtension :: TestTree
test_SplitExtension = testCase "splitExtension" $ do
    ("", Nothing) @=? splitExtension ""
    ("foo", Nothing) @=? splitExtension "foo"
    ("foo", Just "") @=? splitExtension "foo."
    ("foo", Just "a") @=? splitExtension "foo.a"
    ("foo.a/", Nothing) @=? splitExtension "foo.a/"
    ("foo.a/bar", Nothing) @=? splitExtension "foo.a/bar"
    ("foo.a/bar", Just "b") @=? splitExtension "foo.a/bar.b"
    ("foo.a/bar.b", Just "c") @=? splitExtension "foo.a/bar.b.c"