--------------------------------------------------------------------------------
{-# 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
