content: --------------------------------------------------------------------------------
  {-# LANGUAGE OverloadedStrings #-}
  module Hakyll.Core.Runtime.Tests
      ( tests
      ) where
  
  
  --------------------------------------------------------------------------------
  import           Control.Monad       (void)
  import qualified Data.ByteString     as B
  import           Data.List           (isInfixOf)
  import           System.Exit         (ExitCode (..))
  import           System.FilePath     ((</>))
  import           Test.Tasty          (TestTree, testGroup)
  import           Test.Tasty.HUnit    (Assertion, assertBool, (@?=))
  
  
  --------------------------------------------------------------------------------
  import           Hakyll
  import qualified Hakyll.Core.Logger  as Logger
  import           Hakyll.Core.Runtime
  import           TestSuite.Util
  
  
  --------------------------------------------------------------------------------
  tests :: TestTree
  tests = testGroup "Hakyll.Core.Runtime.Tests" $ fromAssertions "run"
      [ case01
      , case02
      , case03
      , case04
      , case05
      , case06
      , issue1000
      , issue1014
      ]
  
  
  --------------------------------------------------------------------------------
  case01 :: Assertion
  case01 = do
      logger <- Logger.new Logger.Error
      _      <- run RunModeNormal testConfiguration logger $ do
          match "images/*" $ do
              route idRoute
              compile copyFileCompiler
  
          match "*.md" $ do
              route   $ setExtension "html"
              compile $ do
                  getResourceBody
                      >>= saveSnapshot "raw"
                      >>= renderParagraphs
  
          match (fromList ["partial.html", "partial-helper.html"]) $
              compile templateCompiler
          create ["partial.html.out"] $ do
              route idRoute
              compile $ do
                  example <- loadSnapshotBody "example.md" "raw"
                  makeItem example
                      >>= loadAndApplyTemplate "partial.html" defaultContext
  
          create ["bodies.txt"] $ do
              route idRoute
              compile $ do
                  items <- loadAllSnapshots "*.md" "raw"
                  makeItem $ concat $ map itemBody (items :: [Item String])
  
      favicon <- B.readFile $
          providerDirectory testConfiguration </> "images/favicon.ico"
      favicon' <- B.readFile $
          destinationDirectory testConfiguration </> "images/favicon.ico"
      favicon @?= favicon'
  
      example <- readFile $
          destinationDirectory testConfiguration </> "example.html"
      lines example @?=  ["<p>This is an example.</p>"]
  
      bodies <- readFile $ destinationDirectory testConfiguration </> "bodies.txt"
      head' (lines bodies) @?=  "This is an example."
  
      partial  <- readFile $ providerDirectory    testConfiguration </> "partial.html.out"
      partial' <- readFile $ destinationDirectory testConfiguration </> "partial.html.out"
      partial @?= partial'
  
      cleanTestEnv
  
    where
      head' (x:_) = x
      head' []    = error "Hakyll.Core.Runtime.Tests.case01: impossible"
  
  
  --------------------------------------------------------------------------------
  case02 :: Assertion
  case02 = do
      logger <- Logger.new Logger.Error
      _      <- run RunModeNormal testConfiguration logger $ do
          match "images/favicon.ico" $ do
              route   $ gsubRoute "images/" (const "")
              compile $ makeItem ("Test" :: String)
  
          match "images/**" $ do
              route   idRoute
              compile copyFileCompiler
  
      favicon <- readFile $
          destinationDirectory testConfiguration </> "favicon.ico"
      favicon @?= "Test"
  
      cleanTestEnv
  
  
  --------------------------------------------------------------------------------
  -- Test that dependency cycles are correctly identified
  case03 :: Assertion
  case03 = do
      (logger, inMemLog) <- Logger.newInMem
      (ec, _) <- run RunModeNormal testConfiguration logger $ do
  
          create ["partial.html.out1"] $ do
              route idRoute
              compile $ do
                  example <- loadBody "partial.html.out2"
                  makeItem example
                      >>= loadAndApplyTemplate "partial.html" defaultContext
  
          create ["partial.html.out2"] $ do
              route idRoute
              compile $ do
                  example <- loadBody "partial.html.out1"
                  makeItem example
                      >>= loadAndApplyTemplate "partial.html" defaultContext
  
      ec @?= ExitFailure 1
      msgs <- inMemLog
      length
          [ msg
          | (Logger.Error, msg) <- msgs, "Dependency cycles:" `isInfixOf` msg
          ] @?= 1
  
      cleanTestEnv
  
  
  --------------------------------------------------------------------------------
  -- Test that dependency cycles are correctly identified when snapshots
  -- are also involved. See issue #878.
  case04 :: Assertion
  case04 = do
      (logger, inMemLog) <- Logger.newInMem
      (ec, _)            <- run RunModeNormal testConfiguration logger $ do
  
          create ["partial.html.out1"] $ do
              route idRoute
              compile $ do
                  example <- loadSnapshotBody "partial.html.out2" "raw"
                  makeItem example
                      >>= loadAndApplyTemplate "partial.html" defaultContext
  
          create ["partial.html.out2"] $ do
              route idRoute
              compile $ do
                  example <- loadSnapshotBody "partial.html.out1" "raw"
                  makeItem example
                      >>= loadAndApplyTemplate "partial.html" defaultContext
  
      ec @?= ExitFailure 1
      msgs <- inMemLog
      length
          [ msg
          | (Logger.Error, msg) <- msgs, "Dependency cycles:" `isInfixOf` msg
          ] @?= 1
  
      cleanTestEnv
  
  
  --------------------------------------------------------------------------------
  -- Test that dependency cycles are correctly identified in the presence of
  -- snapshots. See issue #878.
  case05 :: Assertion
  case05 = do
      logger  <- Logger.new Logger.Error
      (ec, _) <- run RunModeNormal testConfiguration logger $ do
  
          match "posts/*" $ do
              route $ setExtension "html"
              compile $ do
                  let applyDefaultTemplate item = do
                          footer <- loadBody "footer.html"
                          let postCtx' =
                                  constField "footer" footer `mappend`
                                  defaultContext
                          loadAndApplyTemplate "template-empty.html" postCtx' item
  
                  pandocCompiler
                      >>= saveSnapshot "content"
                      >>= loadAndApplyTemplate "template-empty.html" defaultContext
                      >>= applyDefaultTemplate
                      >>= relativizeUrls
  
          create ["footer.html"] $
              compile $ do
                  posts <- fmap (take 5) . recentFirst =<< loadAllSnapshots "posts/*" "content"
                  let footerCtx =
                          listField "posts" defaultContext (return posts) `mappend`
                          defaultContext
  
                  makeItem ""
                      >>= loadAndApplyTemplate "template-empty.html" footerCtx
  
          create ["template-empty.html"] $ compile templateCompiler
  
      ec @?= ExitSuccess
  
      cleanTestEnv
  
  
  --------------------------------------------------------------------------------
  -- Test that dependency cycles are correctly identified in the presence of
  -- snapshots. The test case below was presented as an example which invalidated
  -- a previous approach to dependency cycle checking.
  -- See https://github.com/jaspervdj/hakyll/pull/880#discussion_r708650172
  case06 :: Assertion
  case06 = do
      logger  <- Logger.new Logger.Error
      (ec, _) <- run RunModeNormal testConfiguration logger $ do
  
          create ["one.html"] $ do
              route idRoute
              compile $ do
                  void $ makeItem ("one-one" :: String) >>= saveSnapshot "one"
                  _ <- loadSnapshotBody "two.html" "two" :: Compiler String
                  void $ makeItem ("one-three" :: String) >>= saveSnapshot "three"
                  makeItem ("one-two" :: String) >>= saveSnapshot "two"
  
          create ["two.html"] $ do
              route idRoute
              compile $ do
                  _ <- loadSnapshotBody "one.html" "one" :: Compiler String
                  void $ makeItem ("two-two" :: String) >>= saveSnapshot "two"
                  text <- loadSnapshotBody "one.html" "two"
                  makeItem (text :: String)
  
      ec @?= ExitSuccess
  
      cleanTestEnv
  
  
  --------------------------------------------------------------------------------
  issue1000 :: Assertion
  issue1000 = do
      (logger, inMemLog) <- Logger.newInMem
      (ec, _)            <- run RunModeNormal testConfiguration logger $ do
          match "*.md" $ do
              route $ setExtension "html"
              compile getResourceBody
          match "*.md" $ version "nav" $ do
              route $ setExtension "html"
              compile $ getResourceBody >>= traverse (pure . reverse)
  
      ec @?= ExitFailure 1
      msgs <- inMemLog
      assertBool "missing 'multiple writes' errors" $ not $ null $
          [ msg
          | (Logger.Error, msg) <- msgs, "multiple writes" `isInfixOf` msg
          ]
  
      cleanTestEnv
  
  
  --------------------------------------------------------------------------------
  issue1014 :: Assertion
  issue1014 = do
      (logger, inMemLog) <- Logger.newInMem
      (ec, _)            <- run RunModeNormal testConfiguration logger $ do
          match "*.md" $ do
              route $ setExtension "html"
              -- This compiler will succeed due to laziness, but writing the
              -- result will throw an exception.
              compile $ makeItem ("hello" ++ error "lazyworld")
  
      ec @?= ExitFailure 1
      msgs <- inMemLog
      assertBool "missing 'lazyworld' error" $ not $ null $
          [ msg
          | (Logger.Error, msg) <- msgs, "lazyworld" `isInfixOf` msg
          ]
      assertBool "unwanted 'Success' message" $ not $
          (Logger.Message, "Success") `elem` msgs
      cleanTestEnv
  