hakyll-diagrams-0.1.0.3: test/Util.hs

-- Adapted from https://github.com/jaspervdj/hakyll/blob/master/tests/TestSuite/Util.hs

module Util (
  newTestStore,
  newTestProvider,
  testCompiler,
  testCompilerDone,
  testCompilerError,
  testConfiguration,
  cleanTestEnv,
) where

--------------------------------------------------------------------------------
import Data.List (intercalate, isInfixOf)
import qualified Data.Set as S
-- --------------------------------------------------------------------------------
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Configuration
import Hakyll.Core.Identifier
import qualified Hakyll.Core.Logger as Logger
import Hakyll.Core.Provider
import Hakyll.Core.Store (Store)
import qualified Hakyll.Core.Store as Store
import Hakyll.Core.Util.File
import Test.HUnit


--------------------------------------------------------------------------------
newTestStore :: IO Store
newTestStore = Store.new True $ storeDirectory testConfiguration


--------------------------------------------------------------------------------
newTestProvider :: Store -> IO Provider
newTestProvider store =
#if MIN_VERSION_hakyll(4,17,0)
  fst <$>
#endif
    (newProvider store (const $ return False) $
      providerDirectory testConfiguration)


--------------------------------------------------------------------------------
testCompiler ::
  Store ->
  Provider ->
  Identifier ->
  Compiler a ->
  IO (CompilerResult a)
testCompiler store provider underlying compiler = do
  logger <- Logger.new Logger.Error
  let read' =
        CompilerRead
          { compilerConfig = testConfiguration
          , compilerUnderlying = underlying
          , compilerProvider = provider
          , compilerUniverse = S.empty
          , compilerRoutes = mempty
          , compilerStore = store
          , compilerLogger = logger
          }

  result <- runCompiler compiler read'
  Logger.flush logger
  return result


-- --------------------------------------------------------------------------------
testCompilerDone :: Store -> Provider -> Identifier -> Compiler a -> IO a
testCompilerDone store provider underlying compiler = do
  result <- testCompiler store provider underlying compiler
  case result of
    CompilerDone x _ -> return x
    CompilerError e ->
      fail $
        "TestSuite.Util.testCompilerDone: compiler "
          ++ show underlying
          ++ " threw: "
          ++ intercalate "; " (compilerErrorMessages e)
    CompilerRequire i _ ->
      fail $
        "TestSuite.Util.testCompilerDone: compiler "
          ++ show underlying
          ++ " requires: "
          ++ show i
    CompilerSnapshot _ _ ->
      fail
        "TestSuite.Util.testCompilerDone: unexpected CompilerSnapshot"


testCompilerError :: Store -> Provider -> Identifier -> Compiler a -> String -> IO ()
testCompilerError store provider underlying compiler expectedMessage = do
  result <- testCompiler store provider underlying compiler
  case result of
    CompilerError e ->
      any (expectedMessage `isInfixOf`) (compilerErrorMessages e)
        @? "Expecting '"
        ++ expectedMessage
        ++ "' error"
    _ -> assertFailure "Expecting CompilerError"


--------------------------------------------------------------------------------
testConfiguration :: Configuration
testConfiguration =
  defaultConfiguration
    { destinationDirectory = "_testsite"
    , storeDirectory = "_teststore"
    , tmpDirectory = "_testtmp"
    , providerDirectory = "test"
    }


--------------------------------------------------------------------------------
cleanTestEnv :: IO ()
cleanTestEnv = do
  removeDirectory $ destinationDirectory testConfiguration
  removeDirectory $ storeDirectory testConfiguration
  removeDirectory $ tmpDirectory testConfiguration