system-canonicalpath-0.3.0.0: tests/CanonicalPathTests.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import           BasicPrelude
import qualified Control.Arrow as Arrow(right)
import           Filesystem.CanonicalPath
import           Filesystem.CanonicalPath.Directory
import           Test.Chell

main :: IO ()
main = defaultMain [testCanonicalPath]

testCanonicalPath :: Suite
testCanonicalPath =
  suite "canonical path constructors" $
  [testConstructor]

testConstructor :: Test
testConstructor =
  assertions "canonicalPathE tests" $
  do let left' v = v >>= \v' -> return $ left v'
         equal' v w = do
           v' <- v
           w' <- w
           return $ equal v' w'
         check p1 p2 = equal' (canonicalize' p1) (liftM Right $ inCurrentDir p2)

     $expect $ left' (canonicalize' "diro/")
     $expect $ left' (canonicalize' "dir.txt")
     $expect $ left' (canonicalize' "dir/ab/../../dir/ab/./../file1.tx")
     $expect $ left' (canonicalize' deepFile)

     $expect $ check "dir/" "dir"
     $expect $ check "dir" "dir"
     $expect $ check "file" "file"
     -- check "file/" "file" will fail on linux
     -- but will not fail on os x
     $expect $ check "dir/file1.txt" "dir/file1.txt"
     $expect $ check "dir/ab/" "dir/ab"
     $expect $ check "dir/file" "dir/file"
     $expect $ check "dir/ab/../file" "dir/file"
     $expect $ check "dir/ab/../ab/" "dir/ab"
     $expect $ check "dir/ab/./file2.txt" "dir/ab/file2.txt"
     $expect $ check "dir/ab/../../dir/ab/./../file1.txt" "dir/file1.txt"

     $expect $ equal' (canonicalize "$HOME") (liftM Right getHomeDirectory)
     $expect $ equal' (canonicalize "$HOME/") (liftM Right getHomeDirectory)
     $expect $ equal' (canonicalize "~/") (liftM Right getHomeDirectory)

-- Helper functions

canonicalize :: FilePath -> IO (Either Text CanonicalPath)
canonicalize = canonicalPathE

canonicalize' :: FilePath -> IO (Either Text FilePath)
canonicalize' p = inCurrentDir p >>= liftM (Arrow.right unsafePath) . canonicalize

currentDir :: IO FilePath
currentDir = liftM ((</> "tests") . unsafePath) getCurrentDirectory

inCurrentDir :: FilePath -> IO FilePath
inCurrentDir p =
  do h <- currentDir
     return $ h </> p

deepFile :: FilePath
deepFile = concat $ replicate 500 "deep-hell"