Directory.hs

{-# LANGUAGE CPP #-}
module Tests.Directory where

import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck (Property, (===))
import Test.HUnit.Base hiding (Test)
import Data.Function (on)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mappend)
#endif
import Data.List ((\\), sort)
import qualified Data.DList as DList

import System.FilePath.Glob.Base
import System.FilePath.Glob.Directory
import System.FilePath.Glob.Primitive
import System.FilePath.Glob.Utils
import Tests.Base (PString, unPS)

tests :: Test
tests = testGroup "Directory"
   [ testCase "includeUnmatched" caseIncludeUnmatched
   , testCase "onlyMatched" caseOnlyMatched
   , testGroup "commonDirectory"
       [ testGroup "edge-cases" testsCommonDirectoryEdgeCases
       , testProperty "property" prop_commonDirectory
       ]
   , testCase "globDir1" caseGlobDir1
   , testGroup "repeated-path-separators" testsRepeatedPathSeparators
   ]

caseIncludeUnmatched :: Assertion
caseIncludeUnmatched = do
   let pats = ["**/D*.hs", "**/[MU]*.hs"]
   everything <- getRecursiveContentsDir "System"
   let expectedMatches =
          [ [ "System/FilePath/Glob/Directory.hs" ]
          , [ "System/FilePath/Glob/Match.hs"
            , "System/FilePath/Glob/Utils.hs"
            ]
          ]
   let everythingElse = everything \\ concat expectedMatches

   result <- globDirWith (GlobOptions matchDefault True)
                         (map compile pats)
                         "System"
   mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result))

   case snd result of
       Nothing -> assertFailure "Expected Just a list of unmatched files"
       Just unmatched -> assertEqualUnordered everythingElse unmatched

caseOnlyMatched :: Assertion
caseOnlyMatched = do
   let pats = ["**/D*.hs", "**/[MU]*.hs"]
   let expectedMatches =
          [ [ "System/FilePath/Glob/Directory.hs" ]
          , [ "System/FilePath/Glob/Match.hs"
            , "System/FilePath/Glob/Utils.hs"
            ]
          ]

   result <- globDirWith globDefault
                         (map compile pats)
                         "System"

   mapM_ (uncurry assertEqualUnordered) (zip expectedMatches (fst result))
   assertEqual "" Nothing (snd result)

caseGlobDir1 :: Assertion
caseGlobDir1 = do
   -- this is little a bit of a hack; we pass the same pattern twice to ensure
   -- that the optimization in the single pattern case is bypassed
   let naiveGlobDir1 p = fmap head . globDir [p, p]
   let pat = compile "FilePath/*/*.hs"
   let dir = "System"

   actual <- globDir1 pat dir
   expected <- naiveGlobDir1 pat dir
   assertEqual "" expected actual

assertEqualUnordered :: (Ord a, Show a) => [a] -> [a] -> Assertion
assertEqualUnordered = assertEqual "" `on` sort

-- Like 'getRecursiveContents', except this function removes the root directory
-- from the returned list, so that it should match* the union of matched and
-- unmatched files returned from 'globDirWith', where the same directory was
-- given as the directory argument.
--
-- * to be a little more precise, these files will only match up to
-- normalisation of paths e.g. some patterns will cause the list of matched
-- files to contain repeated slashes, whereas the list returned by this
-- function will not have repeated slashes.
getRecursiveContentsDir :: FilePath -> IO [FilePath]
getRecursiveContentsDir root =
  fmap (filter (/= root) . DList.toList) (getRecursiveContents root)

-- These two patterns should always be equal
prop_commonDirectory' :: String -> (Pattern, Pattern)
prop_commonDirectory' str =
   let pat    = compile str
       (a, b) = commonDirectory pat
    in (pat, literal a `mappend` b)

prop_commonDirectory :: PString -> Property
prop_commonDirectory = uncurry (===) . prop_commonDirectory' . unPS

testsCommonDirectoryEdgeCases :: [Test]
testsCommonDirectoryEdgeCases = zipWith mkTest [1 :: Int ..] testData
 where
   mkTest i (input, expected) =
      testCase (show i) $ do
         assertEqual "" expected (commonDirectory (compile input))
         uncurry (assertEqual "") (prop_commonDirectory' input)

   testData =
      [ ("[.]/*", ("", compile "[.]"))
      , ("foo/[.]bar/*", ("", compile "[.]"))
      , ("[.]foo/bar/*", ("", compile "[.]foo/bar/*"))
      , ("foo.bar/baz/*", ("foo.bar/baz/", compile "*"))
      , ("[f]oo[.]/bar/*", ("foo./bar/", compile "*"))
      , ("foo[.]bar/baz/*", ("foo.bar/baz/", compile "*"))
      , (".[.]/foo/*", ("../foo/", compile "*"))
      ]

-- see #16
testsRepeatedPathSeparators :: [Test]
testsRepeatedPathSeparators = zipWith mkTest [1 :: Int ..] testData
 where
   mkTest i (dir, pat, expected) =
      testCase (show i) $ do
         actual <- globDir1 (compile pat) dir
         assertEqualUnordered expected actual

   testData =
      [ ( "System"
        , "*//Glob///[U]*.hs"
        , [ "System/FilePath//Glob///Utils.hs"
          ]
        )
      , ( "System"
        , "**//[GU]*.hs"
        , [ "System/FilePath//Glob.hs"
          , "System/FilePath/Glob//Utils.hs"
          ]
        )
      , ( "System"
        , "File**/"
        , [ "System/FilePath/"
          ]
        )
      , ( "System"
        , "File**//"
        , [ "System/FilePath//"
          ]
        )
      , ( "System"
        , "File**///"
        , [ "System/FilePath///"
          ]
        )
      , ( "System/FilePath"
        , "**//Glob.hs"
        , [ "System/FilePath//Glob.hs"
          ]
        )
      , ( "System"
        , "**Path/Glob//Utils.hs"
        , [ "System/FilePath/Glob//Utils.hs"
          ]
        )
      ]