gitlib-0.6.4: test/Smoke.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
{-# OPTIONS_GHC -fno-warn-wrong-do-bind #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Main where

import           Bindings.Libgit2.OdbBackend
import           Control.Applicative
import           Control.Concurrent.ParallelIO
import           Control.Monad
import           Data.Git
import           Data.Git.Backend
import           Data.Git.Backend.Trace
import           Data.Maybe
import           Data.Text as T hiding (map)
import qualified Data.Text.Encoding as E
import           Data.Time.Clock.POSIX
import           Data.Traversable
import           Filesystem (removeTree, isDirectory)
import           Filesystem.Path.CurrentOS
import           Foreign.C.String
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable
import qualified Prelude
import           Prelude (putStrLn)
import           Prelude hiding (FilePath, putStr, putStrLn)
import           System.Exit
import           Test.HUnit

default (Text)

main :: IO ()
main = do
  counts' <- runTestTT tests
  case counts' of
    Counts _ _ errors' failures' ->
      if errors' > 0 || failures' > 0
      then exitFailure
      else exitSuccess
  stopGlobalPool

catBlob :: Repository -> Text -> IO (Maybe Text)
catBlob repo sha = do
  hash <- parseOid sha
  for hash $ \hash' -> do
    obj <- lookupObject repo hash'
    case obj of
      Just (BlobObj b) -> do
        (_, contents) <- getBlobContents b
        str <- blobSourceToString contents
        case str of
          Nothing   -> return T.empty
          Just str' -> return (E.decodeUtf8 str')

      Just _  -> error "Found something else..."
      Nothing -> error "Didn't find anything :("

withRepository :: Text -> (Repository -> Assertion) -> Assertion
withRepository n f = do
  let p = fromText n
  exists <- isDirectory p
  when exists $ removeTree p

  -- we want exceptions to leave the repo behind
  f =<< createRepository p True

  removeTree p

oid :: Updatable a => a -> IO Text
oid = objectId >=> return . oidToText . Just

oidToText :: Maybe Oid -> Text
oidToText = T.pack . show . fromJust

sampleCommit :: Repository -> Tree -> Signature -> Commit
sampleCommit repo tr sig =
    (createCommit repo sig) { commitTree = ObjRef tr
                            , commitLog  = "Sample log message." }

tests :: Test
tests = test [

  "singleBlob" ~:

  withRepository "singleBlob.git" $ \repo -> do
    update_ $ createBlob repo (E.encodeUtf8 "Hello, world!\n")

    x <- catBlob repo "af5626b4a114abcb82d63db7c8082c3c4756e51b"
    x @?= Just "Hello, world!\n"

    x <- catBlob repo "af5626b"
    x @?= Just "Hello, world!\n"

    return ()

  , "singleTree" ~:

  withRepository "singleTree.git" $ \repo -> do
    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")
    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)
    x  <- oid tr
    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"

    return()

  , "twoTrees" ~:

  withRepository "twoTrees.git" $ \repo -> do
    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")
    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)
    x  <- oid tr
    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"

    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")
    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)
    x  <- oid tr
    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"

    return()

  , "deleteTree" ~:

  withRepository "deleteTree.git" $ \repo -> do
    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")
    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)
    x  <- oid tr
    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"

    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")
    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)
    x  <- oid tr
    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"

    -- Confirm that deleting world.txt also deletes the now-empty subtree
    -- goodbye/files, which also deletes the then-empty subtree goodbye,
    -- returning us back the original tree.
    tr <- removeFromTree "goodbye/files/world.txt" tr
    x  <- oid tr
    x @?= "c0c848a2737a6a8533a18e6bd4d04266225e0271"

    return()

  , "createCommit" ~:

  withRepository "createCommit.git" $ \repo -> do
    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")
    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)

    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")
    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)
    x  <- oid tr
    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"

    -- The Oid has been cleared in tr, so this tests that it gets written as
    -- needed.
    let sig  = Signature {
            signatureName  = "John Wiegley"
          , signatureEmail = "johnw@newartisans.com"
          , signatureWhen  = posixSecondsToUTCTime 1348980883 }

    x <- oid $ sampleCommit repo tr sig
    x @?= "44381a5e564d19893d783a5d5c59f9c745155b56"

    return()

  , "createTwoCommits" ~:

  withRepository "createTwoCommits.git" $ \repo -> alloca $ \loosePtr -> do
    withCString "createTwoCommits.git/objects" $ \objectsDir -> do
      r <- c'git_odb_backend_loose loosePtr objectsDir (-1) 0
      when (r < 0) $ error "Failed to create loose objects backend"
    loosePtr' <- peek loosePtr
    backend   <- traceBackend loosePtr'
    odbBackendAdd repo backend 3

    let hello = createBlob repo (E.encodeUtf8 "Hello, world!\n")
    tr <- updateTree (createTree repo) "hello/world.txt" (blobRef hello)

    let goodbye = createBlob repo (E.encodeUtf8 "Goodbye, world!\n")
    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye)
    tr <- update tr
    x  <- oid tr
    x @?= "98c3f387f63c08e1ea1019121d623366ff04de7a"

    -- The Oid has been cleared in tr, so this tests that it gets written as
    -- needed.
    let sig = Signature {
            signatureName  = "John Wiegley"
          , signatureEmail = "johnw@newartisans.com"
          , signatureWhen  = posixSecondsToUTCTime 1348980883 }
        c   = sampleCommit repo tr sig
    c <- update c
    x <- oid c
    x @?= "44381a5e564d19893d783a5d5c59f9c745155b56"

    let goodbye2 = createBlob repo (E.encodeUtf8 "Goodbye, world again!\n")
    tr <- updateTree tr "goodbye/files/world.txt" (blobRef goodbye2)
    tr <- update tr
    x  <- oid tr
    x @?= "f2b42168651a45a4b7ce98464f09c7ec7c06d706"

    let sig = Signature {
            signatureName  = "John Wiegley"
          , signatureEmail = "johnw@newartisans.com"
          , signatureWhen  = posixSecondsToUTCTime 1348981883 }
        c2  = (sampleCommit repo tr sig) {
                  commitLog       = "Second sample log message."
                , commitParents   = [ObjRef c] }
    x <- oid c2
    x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603"

    c2 <- update c2
    cid <- objectId c2
    writeRef $ createRef repo "refs/heads/master" (RefTargetId cid)
    writeRef $ createRef repo "HEAD" (RefTargetSymbolic "refs/heads/master")

    x <- oidToText <$> resolveRef repo "refs/heads/master"
    x @?= "2506e7fcc2dbfe4c083e2bd741871e2e14126603"

    mapAllRefs repo (\name -> Prelude.putStrLn $ "Ref: " ++ unpack name)

    ehist <- commitHistoryFirstParent c2
    Prelude.putStrLn $ "ehist: " ++ show ehist

    ehist2 <- commitEntryHistory c2 "goodbye/files/world.txt"
    Prelude.putStrLn $ "ehist2: " ++ show ehist2

    -- oid <- parseOid ("2506e7fc" :: Text)
    -- c3 <- lookupCommit (fromJust oid) repo
    -- ehist3 <- commitEntryHistory "goodbye/files/world.txt" (fromJust c3)
    -- Prelude.putStrLn $ "ehist3: " ++ show ehist3

    oid <- parseOid ("2506e7fc" :: Text)
    c4 <- lookupCommit repo (fromJust oid)
    c5 <- maybe (return Nothing) (lookupCommit repo) oid
    c6 <- lookupCommit repo (fromJust oid)
    ehist4 <- commitEntryHistory (fromJust c4) "goodbye/files/world.txt"
    Prelude.putStrLn $ "ehist4: " ++ show (Prelude.head ehist4)

  , "smallTest1" ~:

  withRepository "smallTest1.git" $ \repo -> do
    let blob =
          createBlob repo "# Auto-created repository for tutorial contents\n"
        masterRef = "refs/heads/master"
        sig = Signature { signatureName   = "First Name"
                        , signatureEmail = "user1@email.org"
                        , signatureWhen  = posixSecondsToUTCTime 1348981883 }
    tree <- updateTree (createTree repo) "README.md" (blobRef blob)
    commit <- writeCommit (createCommit repo sig)
            { commitLog       = "Initial commit"
            , commitTree      = ObjRef tree
            } (Just masterRef)
    c1id <- objectId commit
    print $ "commit1 sha = " ++ show c1id

    let sig2 = Signature { signatureName   = "Second Name"
                         , signatureEmail = "user2@email.org"
                         , signatureWhen  = posixSecondsToUTCTime 1348982883 }
    blob <- writeBlob $ createBlob repo "This is some content."
    blobOID <- objectId blob
    commit' <- updateCommit commit {
          commitAuthor = sig
        , commitCommitter = sig
        , commitLog = "This is another log message."
        , commitParents = [ObjRef commit]
        } "foo.txt" (blobRef blob)
    commitOID <- objectId commit'
    print $ "commit2 sha = " ++ show commitOID
    writeRef_ $ createRef repo masterRef $ RefTargetId commitOID

    True @?= True

    return ()

  ]

-- Main.hs ends here