directory-layout-0.3.0.0: tests/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnicodeSyntax #-}
module Main where

import Control.Exception (finally)
import System.Exit (exitSuccess, exitFailure)
import System.IO.Error

import System.Directory.Layout
import Test.HUnit hiding (assert)
import System.Process (rawSystem)


main ∷ IO ()
main = do
  z ← runTestTT tests
  if errors z + failures z > 0
    then exitFailure
    else exitSuccess
 where
  tests = TestList
    [ TestLabel "trivia1" testTrivia1
    , TestLabel "trivia2" testTrivia2
    , TestLabel "dual1" testDual1
    ]


testTrivia1 ∷ Test
testTrivia1 = TestCase $ do
  install
  check' >>= assertEqual "correct" []

  install
  rawSystem "rm" ["-rf", "directory-layout-test/x/y"]
  check' >>= assertEqual "deleted y"
    [ DE doesNotExistErrorType "x/y"
    , FE doesNotExistErrorType "x/y/s"
    , FE doesNotExistErrorType "x/y/v"
    ]

  install
  rawSystem "rm" ["-rf", "directory-layout-test/z"]
  check' >>= assertEqual "deleted z"
    [ DE doesNotExistErrorType "z"
    , RF doesNotExistErrorType "z/w" "text"
    ]

  install
  rawSystem "rm" ["-rf", "directory-layout-test/x/y/s"]
  check' >>= assertEqual "deleted s" [FE doesNotExistErrorType "x/y/s"]

  install
  writeFile "directory-layout-test/z/w" "foo"
  check' >>= assertEqual "changed z/w" [RF userErrorType "z/w" "text"]
 `finally`
  rawSystem "rm" ["-rf", "directory-layout-test"]
 where
  install = do
    rawSystem "mkdir" ["--parents", "directory-layout-test"]
    rawSystem "mkdir" ["--parents", "directory-layout-test/x/y"]
    rawSystem "mkdir" ["--parents", "directory-layout-test/z"]
    rawSystem "touch" ["directory-layout-test/x/y/s"]
    rawSystem "touch" ["directory-layout-test/x/y/v"]
    rawSystem "touch" ["directory-layout-test/z/w"]
    writeFile "directory-layout-test/z/w" "text"

  script = do
    directory "x" $
      directory "y" $ do
        file_ "s"
        file_ "v"
    directory "z" $
      file "w" "text"

  check' = check script "directory-layout-test"


testTrivia2 ∷ Test
testTrivia2 = TestCase $ do
  rawSystem "mkdir" ["--parents", "directory-layout-test"]
  install
  check' >>= assertEqual "correct" []

  install
  rawSystem "rm" ["-rf", "directory-layout-test/x/y"]
  check' >>= assertEqual "deleted y"
    [ DE doesNotExistErrorType "x/y"
    , FE doesNotExistErrorType "x/y/s"
    , FE doesNotExistErrorType "x/y/v"
    ]

  install
  rawSystem "rm" ["-rf", "directory-layout-test/z"]
  check' >>= assertEqual "deleted z"
    [ DE doesNotExistErrorType "z"
    , RF doesNotExistErrorType "z/w" "text"
    ]

  install
  rawSystem "rm" ["-rf", "directory-layout-test/x/y/s"]
  check' >>= assertEqual "deleted s" [FE doesNotExistErrorType "x/y/s"]

  install
  writeFile "directory-layout-test/z/w" "foo"
  check' >>= assertEqual "changed z/w" [RF userErrorType "z/w" "text"]
 `finally`
  rawSystem "rm" ["-rf", "directory-layout-test"]
 where
  install = make script "directory-layout-test"

  script = do
    directory "x" $
      directory "y" $ do
        file_ "s"
        file_ "v"
    directory "z" $
      file "w" "text"

  check' = check script "directory-layout-test"


testDual1 ∷ Test
testDual1 = TestCase $ do
  rawSystem "mkdir" ["--parents", "directory-layout-test"]
  let s = do
        directory "x" $ do
          directory_ "xx"
          directory "xy" $
            file "xyx" "test1"
          file "xz" "test2"
          file "xz'" "test3"
          file_ "xz''"
        directory "y" $ do
          file "yx" "test4"
          file "yy" "test5"
          file_ "yz"
        directory_ "z"
  test' s
 `finally`
  rawSystem "rm" ["-rf", "directory-layout-test"]
 where
  test' s = make' s >> check' s
  make' s = make s "directory-layout-test"
  check' s = check s "directory-layout-test" >>= assertEqual "dual" []