{-# LANGUAGE TemplateHaskell #-}

module System.HapistranoSpec
  ( spec )
where

import Control.Monad
import Control.Monad.Reader
import Path
import Path.IO
import Data.Maybe (catMaybes)
import System.Hapistrano.Types
import System.Info (os)
import System.IO
import Test.Hspec hiding (shouldBe, shouldReturn)
import qualified System.Hapistrano as Hap
import qualified System.Hapistrano.Commands as Hap
import qualified System.Hapistrano.Core as Hap
import qualified Test.Hspec as Hspec

testBranchName :: String
testBranchName = "another_branch"

spec :: Spec
spec = do
  describe "readScript" $
    it "performs all the necessary normalizations correctly" $ do
      spath <- makeAbsolute $(mkRelFile "script/clean-build.sh")
      (fmap Hap.unGenericCommand <$> Hap.readScript spath)
        `Hspec.shouldReturn`
        [ "export PATH=~/.cabal/bin:/usr/local/bin:$PATH"
        , "cabal sandbox delete"
        , "cabal sandbox init"
        , "cabal clean"
        , "cabal update"
        , "cabal install --only-dependencies -j"
        , "cabal build -j" ]

  around withSandbox $ do
    describe "pushRelease" $ do
      it "sets up repo all right" $ \(deployPath, repoPath) -> runHap $ do
        let task = mkTask deployPath repoPath
        release <- Hap.pushRelease task
        rpath   <- Hap.releasePath deployPath release
        -- let's check that the dir exists and contains the right files
        (liftIO . readFile . fromAbsFile) (rpath </> $(mkRelFile "foo.txt"))
          `shouldReturn` "Foo!\n"

      it "deploys properly a branch other than master" $ \(deployPath, repoPath) -> runHap $ do
        let task = mkTaskWithCustomRevision deployPath repoPath testBranchName
        release <- Hap.pushRelease task
        rpath   <- Hap.releasePath deployPath release
        -- let's check that the dir exists and contains the right files
        (liftIO . readFile . fromAbsFile) (rpath </> $(mkRelFile "bar.txt"))
            `shouldReturn` "Bar!\n"
        -- This fails if the opened branch is not testBranchName
        justExec rpath ("test `git rev-parse --abbrev-ref HEAD` = " ++ testBranchName)
        -- This fails if there are unstaged changes
        justExec rpath "git diff --exit-code"

    describe "registerReleaseAsComplete" $
      it "creates the token all right" $ \(deployPath, repoPath) -> runHap $ do
        let task = mkTask deployPath repoPath
        release <- Hap.pushRelease task
        Hap.registerReleaseAsComplete deployPath release
        (Hap.ctokenPath deployPath release >>= doesFileExist) `shouldReturn` True

    describe "activateRelease" $
      it "creates the ‘current’ symlink correctly" $ \(deployPath, repoPath) -> runHap $ do
        let task = mkTask deployPath repoPath
        release <- Hap.pushRelease task
        Hap.activateRelease currentSystem deployPath release
        rpath <- Hap.releasePath deployPath release
        let rc :: Hap.Readlink Dir
            rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
        Hap.exec rc `shouldReturn` rpath
        doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False

    describe "playScriptLocally (successful run)" $
       it "check that local scripts are run and deployment is successful" $ \(deployPath, repoPath) -> runHap $ do
        let localCommands = catMaybes $ map Hap.mkGenericCommand ["pwd", "ls"]
            task = mkTask deployPath repoPath
        Hap.playScriptLocally localCommands
        release <- Hap.pushRelease task
        Hap.registerReleaseAsComplete deployPath release
        (Hap.ctokenPath deployPath release >>= doesFileExist) `shouldReturn` True

    describe "playScriptLocally (error exit)" $
       it "check that deployment isn't done" $ \(deployPath, repoPath) -> (runHap $ do
        let localCommands = catMaybes $ map Hap.mkGenericCommand ["pwd", "ls", "false"]
            task = mkTask deployPath repoPath
        Hap.playScriptLocally localCommands
        release <- Hap.pushRelease task
        Hap.registerReleaseAsComplete deployPath release) `shouldThrow` anyException

    describe "rollback" $ do
      context "without completion tokens" $
        it "resets the ‘current’ symlink correctly" $ \(deployPath, repoPath) -> runHap $ do
          let task = mkTask deployPath repoPath
          rs <- replicateM 5 (Hap.pushRelease task)
          Hap.rollback currentSystem deployPath 2
          rpath <- Hap.releasePath deployPath (rs !! 2)
          let rc :: Hap.Readlink Dir
              rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
          Hap.exec rc `shouldReturn` rpath
          doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False
      context "with completion tokens" $
        it "resets the ‘current’ symlink correctly" $ \(deployPath, repoPath) -> runHap $ do
          let task = mkTask deployPath repoPath
          rs <- replicateM 5 (Hap.pushRelease task)
          forM_ (take 3 rs) (Hap.registerReleaseAsComplete deployPath)
          Hap.rollback currentSystem deployPath 2
          rpath <- Hap.releasePath deployPath (rs !! 0)
          let rc :: Hap.Readlink Dir
              rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
          Hap.exec rc `shouldReturn` rpath
          doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False

    describe "dropOldReleases" $
      it "works" $ \(deployPath, repoPath) -> runHap $ do
        rs <- replicateM 7 $ do
          r <- Hap.pushRelease (mkTask deployPath repoPath)
          Hap.registerReleaseAsComplete deployPath r
          return r
        Hap.dropOldReleases deployPath 5
        -- two oldest releases should not survive:
        forM_ (take 2 rs) $ \r ->
          (Hap.releasePath deployPath r >>= doesDirExist)
            `shouldReturn` False
        -- 5 most recent releases should stay alive:
        forM_ (drop 2 rs) $ \r ->
          (Hap.releasePath deployPath r >>= doesDirExist)
            `shouldReturn` True
        -- two oldest completion tokens should not survive:
        forM_ (take 2 rs) $ \r ->
          (Hap.ctokenPath deployPath r >>= doesFileExist)
            `shouldReturn` False
        -- 5 most recent completion tokens should stay alive:
        forM_ (drop 2 rs) $ \r ->
          (Hap.ctokenPath deployPath r >>= doesFileExist)
            `shouldReturn` True

----------------------------------------------------------------------------
-- Helpers

infix 1 `shouldBe`, `shouldReturn`

-- | Lifted 'Hspec.shouldBe'.

shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m ()
shouldBe x y = liftIO (x `Hspec.shouldBe` y)

-- | Lifted 'Hspec.shouldReturn'.

shouldReturn :: (MonadIO m, Show a, Eq a) => m a -> a -> m ()
shouldReturn m y = m >>= (`shouldBe` y)

-- | The sandbox prepares the environment for an independent round of
-- testing. It provides two paths: deploy path and path where git repo is
-- located.

withSandbox :: ActionWith (Path Abs Dir, Path Abs Dir) -> IO ()
withSandbox action = withSystemTempDir "hap-test" $ \dir -> do
  let dpath = dir </> $(mkRelDir "deploy")
      rpath = dir </> $(mkRelDir "repo")
  ensureDir dpath
  ensureDir rpath
  populateTestRepo rpath
  action (dpath, rpath)

-- | Given path where to put the repo, generate it for testing.

populateTestRepo :: Path Abs Dir -> IO ()
populateTestRepo path = runHap $ do
  justExec path "git init"
  justExec path "git config --local --replace-all push.default simple"
  justExec path "git config --local --replace-all user.email   hap@hap"
  justExec path "git config --local --replace-all user.name    Hap"
  justExec path "echo 'Foo!' > foo.txt"
  justExec path "git add -A"
  justExec path "git commit -m 'Initial commit'"
  -- Add dummy content to a branch that is not master
  justExec path ("git checkout -b " ++ testBranchName)
  justExec path "echo 'Bar!' > bar.txt"
  justExec path "git add bar.txt"
  justExec path "git commit -m 'Added more bars to another branch'"
  justExec path "git checkout master"


-- | Execute arbitrary commands in the specified directory.

justExec :: Path Abs Dir -> String -> Hapistrano ()
justExec path cmd' =
  case Hap.mkGenericCommand cmd' of
    Nothing -> Hap.failWith 1 (Just $ "Failed to parse the command: " ++ cmd')
    Just cmd -> Hap.exec (Hap.Cd path cmd)

-- | Run 'Hapistrano' monad locally.

runHap :: Hapistrano a -> IO a
runHap m = do
  let printFnc dest str =
        case dest of
          StdoutDest -> putStr str
          StderrDest -> hPutStr stderr str
  r <- Hap.runHapistrano Nothing printFnc m
  case r of
    Left n -> do
      expectationFailure ("Failed with status code: " ++ show n)
      return undefined
      -- ↑ because expectationFailure from Hspec has wrong type :-(
    Right x -> return x

-- | Make a 'Task' given deploy path and path to the repo.

mkTask :: Path Abs Dir -> Path Abs Dir -> Task
mkTask deployPath repoPath = mkTaskWithCustomRevision deployPath repoPath "master"

mkTaskWithCustomRevision :: Path Abs Dir -> Path Abs Dir -> String -> Task
mkTaskWithCustomRevision deployPath repoPath revision = Task
  { taskDeployPath    = deployPath
  , taskRepository    = fromAbsDir repoPath
  , taskRevision      = revision
  , taskReleaseFormat = ReleaseLong }

currentSystem :: TargetSystem
currentSystem = if os == "linux"
                then GNULinux
                else BSD