content: --
  -- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others
  --
  -- The code in this file, and the program it is a part of, is
  -- made available to you by its authors as open source software:
  -- you can redistribute it and/or modify it under the terms of
  -- the 3-clause BSD licence.
  --
  
  {-# LANGUAGE FlexibleContexts      #-}
  {-# LANGUAGE MultiParamTypeClasses #-}
  {-# LANGUAGE OverloadedLists       #-}
  {-# LANGUAGE OverloadedStrings     #-}
  {-# LANGUAGE RecordWildCards       #-}
  
  -- | Description: Test git repository setup.
  module Main where
  
  import           Control.Applicative
  import           Control.Monad
  import           Data.Foldable                      (traverse_)
  import           Data.Map                           (fromList)
  import           Data.Traversable                   (traverse)
  import           System.Directory
  import           System.FilePath
  import           System.IO.Temp
  import           System.Process
  import           Test.Hspec
  
  import           Git.Vogue.PluginCommon
  import           Git.Vogue.PluginDiscoverer.Libexec
  import           Git.Vogue.Types
  import           Git.Vogue.VCS.Git
  
  main :: IO ()
  main = do
      abs_fixtures <- canonicalizePath "fixtures"
      hspec $ do
          describe "Git VCS implementation" $
              testGitVCS gitVCS
          describe "Libexec plugin discovery" $
              testLEDiscovery abs_fixtures (libExecDiscoverer "./plugins")
          describe "Plugin helpers" .
              it "finds hs projects" $ do
                  hsProjects ["a.hs"] ["a.cabal", "a.hs"] `shouldBe`
                      fromList [("", ["a.hs"])]
  
                  let nested = ["a.cabal", "a.hs", "b/b.cabal", "b/b.hs"]
                  join hsProjects nested `shouldBe`
                      fromList [ ("",["a.cabal","a.hs"])
                               , ("b/",["b.cabal", "b.hs"]) ]
  
  -- These tests are nasty and you have my permission to kill them - Christian
  testLEDiscovery :: FilePath -> PluginDiscoverer IO -> Spec
  testLEDiscovery fixtures PluginDiscoverer{..} = do
      it "discovers plugins in the libexec dir" . withSetup $  do
          ps <- discoverPlugins
          fmap pluginName ps `shouldBe`
              ["(non-executable) ./plugins/non-executable"
              ,"exploding"
              ,"failing"
              ,"succeeding"
              ]
          fmap enabled ps `shouldBe` [False, True, True, True]
  
      it "disables and re-enables plugins" . withSetup $ do
          disablePlugin "exploding"
          ps <- filter enabled <$> discoverPlugins
          fmap pluginName ps `shouldBe` ["failing", "succeeding"]
  
          enablePlugin "exploding"
          ps' <- filter enabled <$> discoverPlugins
          fmap pluginName ps' `shouldBe` ["exploding", "failing", "succeeding"]
  
  
      it "provides check methods that do the expected things" . withSetup $ do
          ps <- filter enabled <$> discoverPlugins
          rs <- traverse (\Plugin{..} -> runCheck ["a"] ["a"]) ps
          rs `shouldBe` [ Catastrophe 3 "something broke\n"
                        , Failure "ohnoes\n"
                        , Success "yay\n"]
  
      it "provides fix methods that do the expected things" . withSetup $ do
          ps <- filter enabled <$> discoverPlugins
          rs <- traverse (\Plugin{..} -> runFix ["a"] ["a"]) ps
          rs `shouldBe` [ Catastrophe 3 "something broke\n"
                        , Failure "ohnoes\n"
                        , Success "yay\n"]
    where
      withSetup =
          withGitRepo
          . withCopy (fixtures </> "plugins")  "./"
  
  testGitVCS :: VCS IO -> Spec
  testGitVCS VCS{..} = do
          it "should install and remove a pre-commit hook" . withGitRepo $ do
              checkHook >>= (`shouldBe` False)
              installHook
              checkHook >>= (`shouldBe` True)
              removeHook
              checkHook >>= (`shouldBe` False)
  
          it "should list files correctly"  . withGitRepo $ do
              getFiles FindChanged >>= (`shouldBe` [])
              getFiles FindAll     >>= (`shouldBe` [])
  
              writeFile "hi" "there"
              getFiles FindChanged >>= (`shouldBe` [])
              getFiles FindAll     >>= (`shouldBe` [])
  
              void $ git ["add", "hi"]
              getFiles FindChanged >>= (`shouldBe` ["hi"])
              getFiles FindAll     >>= (`shouldBe` ["hi"])
  
              void $ git ["commit", "-m", "add hi", "hi"]
              getFiles FindChanged >>= (`shouldBe` [])
              getFiles FindAll     >>= (`shouldBe` ["hi"])
  
          it "should list root dir correctly" . withGitRepo' $ \dir ->
              getTopLevel >>= (`shouldBe` dir)
  
  -- | Copy a dir and continue along
  withCopy :: FilePath
           -> FilePath
           -> IO ()
           -> IO ()
  withCopy src dst f = do
      void $ rawSystem "mkdir" ["plugins"]
      void $ rawSystem "cp" ["-r", src,  dst]
      f
  
  withGitRepo
      :: IO ()
      -> IO ()
  withGitRepo = withGitRepo' . const
  
  -- | Create a git repository and run an action with it, after changing to that
  -- directory.
  --
  -- Restores current dir on completion
  withGitRepo'
      :: (String -> IO ())
      -> IO ()
  withGitRepo' f =
      withSystemTempDirectory "git-setup-test." $ \temp_dir -> do
          -- For some unknown reason, setting the current directory appears to do
          -- strange things with a bracket, so we don't bracket.
          canonical_dir <- canonicalizePath temp_dir
          before_dir <- getCurrentDirectory
          let setup = [ ["init", canonical_dir]
                        , ["config", "--local", "user.email", "test"]
                        , ["config", "--local", "user.name", "test2"]
                      ] :: [[String]]
  
          setCurrentDirectory canonical_dir
          traverse_ git setup
          f canonical_dir
          setCurrentDirectory before_dir
  