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 Storage.Hashed
import Storage.Hashed.AnchoredPath
import Storage.Hashed.Tree
import Storage.Hashed.Index
import Storage.Hashed.Utils
import Storage.Hashed.Darcs

testsDarcsBasic :: Test
testsDarcsBasic =
    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 = forM_ files . check_file
      have_files = TestCase $ readPlainTree "." >>= expand >>= check_files
      have_pristine_files = TestCase $
         readDarcsPristine "." >>= expand >>= 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 "." >>= expand
        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 "." >>= expand
        sequence_ [
          do our <- read b
             darcs <- readProcess "darcs" [ "show", "contents",
                                            anchorPath "." p ] ""
             assertEqual "contents match" (BL.unpack our) darcs
         | (p, File b) <- list t ]

testsTreeIndex :: Test
testsTreeIndex =
    TestList [ TestLabel "check_index" check_index
             , TestLabel "check_index_content" check_index_content ]
    where pristine = readDarcsPristine "." >>= expand
          {-
          working = do
            x <- pristine
            plain <- readPlainTree "."
            expand (restrict x plain)
          -}
          build_index =
            do x <- pristine >>= expand
               idx <- updateIndexFrom "_darcs/index" darcsTreeHash x >>= expand
               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)

testsGeneric :: Test
testsGeneric = 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")]
                  modify = modifyTree t (floatPath "foo") (Just $ blob "bla")
               in do x <- read $ fromJust $ findFile t (floatPath "foo")
                     y <- read $ fromJust $ findFile modify (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") ]
                  modify = modifyTree t (floatPath "bar/foo") (Just $ blob "bla")
               in do foo <- read $ fromJust $ findFile t (floatPath "foo")
                     foo' <- read $ fromJust $ findFile modify (floatPath "foo")
                     bar_foo <- read $ fromJust $
                                findFile t (floatPath "bar/foo")
                     bar_foo' <- read $ fromJust $
                                 findFile modify (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")

emptyStub = Stub (return emptyTree) Nothing
testTree = makeTree [ (makeName "foo", emptyStub)
                    , (makeName "subtree", SubTree sub) ]
    where sub = makeTree [ (makeName "stub", emptyStub)
                         , (makeName "x", SubTree emptyTree)]

testsTree :: Test
testsTree = TestList [ TestLabel "check_expand" check_expand ]
    where no_stubs t = null [ () | (_, Stub _ _) <- list t]
          check_expand = TestCase $ do
                           x <- expand testTree
                           assertBool "no stubs in testTree" $
                                    not (no_stubs testTree)
                           assertBool "stubs in expanded tree" $ no_stubs x