module Storage.Hashed.Test where

import Prelude hiding ( read )
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.ByteString.Char8 as BS
import Test.HUnit
import System.Process
import Control.Monad( forM_ )
import Data.Maybe
import Data.List( (\\), sort )
import System.Directory
import Storage.Hashed
import Storage.Hashed.AnchoredPath
import Storage.Hashed.Tree
import Storage.Hashed.Index
import Storage.Hashed.Utils

tests_darcs_basic =
    TestList [ TestLabel "have_files" have_files
             , TestLabel "have_pristine_files" have_pristine_files
             , TestLabel "darcs_manifest" darcs_manifest
             , TestLabel "darcs_contents" darcs_contents ]
    where
      files = [ floatPath "hashed-storage.cabal"
              , floatPath "Storage/Hashed.hs"
              , floatPath "Storage/Hashed/Index.hs" ]
      check_file t f = assertBool
                       ("path " ++ show f ++ " is in tree")
                       (isJust $ find t f)
      check_files t = forM_ files (check_file t)
      have_files = TestCase $ readPlainTree "." >>= unfold >>= check_files
      have_pristine_files = TestCase $
         readDarcsPristine "." >>= unfold >>= check_files

      -- NB. If darcs starts using hashed-storage internally, the following
      -- tests become useless, since they check our code against darcs.
      darcs_manifest = TestCase $ do
        f <- lines `fmap` readProcess "darcs" ["show", "files" ] ""
        t <- readDarcsPristine "." >>= unfold
        forM_ (f \\ ["."]) (\x -> check_file t (floatPath x))
        forM_ (list t)
              (\x -> assertBool (show (fst x) ++ " is in darcs show files") $
                     anchorPath "." (fst x) `elem` f)
      darcs_contents = TestCase $ do
        t <- readDarcsPristine "." >>= unfold
        sequence_ [
          do our <- read b
             darcs <- readProcess "darcs" [ "show", "contents",
                                            anchorPath "." p ] ""
             assertEqual "contents match" (BL.unpack our) darcs
         | (p, File b) <- list t ]

tests_tree_index =
    TestList [ TestLabel "check_index" check_index
             , TestLabel "check_index_content" check_index_content ]
    where pristine = readDarcsPristine "." >>= unfold
          working = do
            x <- pristine
            plain <- readPlainTree "."
            unfold (restrict x plain)
          build_index =
            do x <- pristine >>= unfold
               idx <- updateIndexFrom x >>= unfold
               return (x, idx)
          check_index = TestCase $
            do (pris, idx) <- build_index
               (sort $ map fst $ list idx) @?= (sort $ map fst $ list pris)
          check_blob_pair p x y =
              do a <- read x
                 b <- read y
                 assertEqual ("content match on " ++ show p) a b
          check_index_content = TestCase $
            do (_, idx) <- build_index
               plain <- readPlainTree "."
               x <- sequence $ zipCommonFiles check_blob_pair plain idx
               assertBool "files match" (length x > 0)

tests_generic = TestList [ TestLabel "check_modify" check_modify
                         , TestLabel "check_modify_complex" check_modify_complex
                         ]
    where blob x = File $ Blob (return (BL.pack x)) (Just $ sha256 $ BL.pack x)
          name = Name . BS.pack
          check_modify = TestCase $
              let t = makeTree [(name "foo", blob "bar")]
                  mod = modifyTree t (floatPath "foo") (Just $ blob "bla")
               in do x <- read $ fromJust $ findFile t (floatPath "foo")
                     y <- read $ fromJust $ findFile mod (floatPath "foo")
                     assertEqual "old version" x (BL.pack "bar")
                     assertEqual "new version" y (BL.pack "bla")
          check_modify_complex = TestCase $
              let t = makeTree [ (name "foo", blob "bar")
                               , (name "bar", SubTree t1) ]
                  t1 = makeTree [ (name "foo", blob "bar") ]
                  mod = modifyTree t (floatPath "bar/foo") (Just $ blob "bla")
               in do foo <- read $ fromJust $ findFile t (floatPath "foo")
                     foo' <- read $ fromJust $ findFile mod (floatPath "foo")
                     bar_foo <- read $ fromJust $
                                findFile t (floatPath "bar/foo")
                     bar_foo' <- read $ fromJust $
                                 findFile mod (floatPath "bar/foo")
                     assertEqual "old foo" foo (BL.pack "bar")
                     assertEqual "old bar/foo" bar_foo (BL.pack "bar")
                     assertEqual "new foo" foo' (BL.pack "bar")
                     assertEqual "new bar/foo" bar_foo' (BL.pack "bla")