cabal-install/tests/UnitTests/Distribution/Client/Tar.hs

   1 module UnitTests.Distribution.Client.Tar
   2   ( tests
   3   ) where
   4
   5 import Codec.Archive.Tar
   6   ( foldEntries
   7   )
   8 import Codec.Archive.Tar.Entry
   9   ( simpleEntry
  10   , toTarPath
  11   )
  12 import Distribution.Client.Tar
  13   ( filterEntries
  14   , filterEntriesM
  15   )
  16
  17 import Test.Tasty
  18 import Test.Tasty.HUnit
  19
  20 import Control.Monad.Writer.Lazy (runWriterT, tell)
  21 import qualified Data.ByteString.Lazy as BS
  22 import qualified Data.ByteString.Lazy.Char8 as BS.Char8
  23
  24 import Distribution.Client.Compat.Tar
  25
  26 tests :: [TestTree]
  27 tests =
  28   [ testCase "filterEntries" filterTest
  29   , testCase "filterEntriesM" filterMTest
  30   ]
  31
  32 filterTest :: Assertion
  33 filterTest = do
  34   let e1 = getFileEntry "file1" "x"
  35       e2 = getFileEntry "file2" "y"
  36       p =
  37         ( \e ->
  38             let str = BS.Char8.unpack $ case entryContent e of
  39                   NormalFile dta _ -> dta
  40                   _ -> error "Invalid entryContent"
  41              in str /= "y"
  42         )
  43   assertEqual "Unexpected result for filter" "xz" $
  44     entriesToString $
  45       filterEntries p $
  46         Next e1 $
  47           Next e2 Done
  48   assertEqual "Unexpected result for filter" "z" $
  49     entriesToString $
  50       filterEntries p $
  51         Done
  52   assertEqual "Unexpected result for filter" "xf" $
  53     entriesToString $
  54       filterEntries p $
  55         Next e1 $
  56           Next e2 $
  57             Fail "f"
  58
  59 filterMTest :: Assertion
  60 filterMTest = do
  61   let e1 = getFileEntry "file1" "x"
  62       e2 = getFileEntry "file2" "y"
  63       p =
  64         ( \e ->
  65             let str = BS.Char8.unpack $ case entryContent e of
  66                   NormalFile dta _ -> dta
  67                   _ -> error "Invalid entryContent"
  68              in tell "t" >> return (str /= "y")
  69         )
  70
  71   (r, w) <- runWriterT $ filterEntriesM p $ Next e1 $ Next e2 Done
  72   assertEqual "Unexpected result for filterM" "xz" $ entriesToString r
  73   assertEqual "Unexpected result for filterM w" "tt" w
  74
  75   (r1, w1) <- runWriterT $ filterEntriesM p $ Done
  76   assertEqual "Unexpected result for filterM" "z" $ entriesToString r1
  77   assertEqual "Unexpected result for filterM w" "" w1
  78
  79   (r2, w2) <- runWriterT $ filterEntriesM p $ Next e1 $ Next e2 $ Fail "f"
  80   assertEqual "Unexpected result for filterM" "xf" $ entriesToString r2
  81   assertEqual "Unexpected result for filterM w" "tt" w2
  82
  83 getFileEntry :: FilePath -> [Char] -> Entry
  84 getFileEntry pth dta =
  85   simpleEntry tp $ NormalFile dta' $ BS.length dta'
  86   where
  87     tp = case toTarPath False pth of
  88       Right tp' -> tp'
  89       Left e -> error e
  90     dta' = BS.Char8.pack dta
  91
  92 entriesToString :: Entries String -> String
  93 entriesToString =
  94   foldEntries
  95     ( \e acc ->
  96         let str = BS.Char8.unpack $ case entryContent e of
  97               NormalFile dta _ -> dta
  98               _ -> error "Invalid entryContent"
  99          in str ++ acc
 100     )
 101     "z"
 102     id