{-# LANGUAGE NoImplicitPrelude #-}

module Felix.Test.Unit.OutputPlan (unitTests) where

import Base
import Felix.OutputPlan qualified as Output
import Felix.Source
import Felix.Store qualified as Store

import Control.Exception qualified as Exception
import System.Directory qualified as Directory
import System.Environment qualified as Environment
import System.FilePath.Posix qualified as Posix
import System.IO.Temp qualified as Temp
import Test.Tasty
import Test.Tasty.HUnit


unitTests :: TestTree
unitTests =
    testGroup "Verification output preflight"
        [ testCase "accepts absent and empty dump destinations"
            acceptsAbsentAndEmptyDumpDestinations
        , testCase "rejects a nonempty dump before store startup"
            rejectsNonemptyDumpBeforeStoreStartup
        , testCase "rejects persistent and fresh store collisions"
            rejectsStoreCollisions
        , testCase "reserves the store rollback journal"
            reservesRollbackJournal
        , testCase "rejects dump and HTML route collisions"
            rejectsDumpHtmlCollisions
        ]

acceptsAbsentAndEmptyDumpDestinations :: Assertion
acceptsAbsentAndEmptyDumpDestinations =
    Temp.withSystemTempDirectory "felix-output-dump" \root -> do
        let storeParent = root Posix.</> "store"
            storeFile = storeParent Posix.</> "store.sqlite"
            dump = root Posix.</> "dump"
        Directory.createDirectory storeParent
        plan <- expectRightIO
            (Store.planStore
                (Store.ExplicitStore storeFile))
        Store.withStoreLease plan \lease -> do
            absent <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                (Just dump)
                Nothing
            plannedAbsent <- expectOutputRight absent
            assertEqual "absent dump path"
                (Just dump)
                (Output.dumpOutputPath
                    <$> Output.verificationDumpOutput plannedAbsent)

            Directory.createDirectory dump
            emptyResult <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                (Just dump)
                Nothing
            void (expectOutputRight emptyResult)

rejectsNonemptyDumpBeforeStoreStartup :: Assertion
rejectsNonemptyDumpBeforeStoreStartup =
    Temp.withSystemTempDirectory "felix-output-before-store" \root -> do
        let cacheRoot = root Posix.</> "cache"
            dump = root Posix.</> "dump"
        Directory.createDirectory cacheRoot
        Directory.createDirectory dump
        writeFile (dump Posix.</> "old.p") "stale"
        withEnvironment "XDG_CACHE_HOME" cacheRoot do
            plan <- expectRightIO
                (Store.planStore Store.DefaultStore)
            Store.withStoreLease plan \lease -> do
                result <- Output.planVerificationOutputs
                    (Store.storeLeasePath lease)
                    (Just dump)
                    Nothing
                case result of
                    Left Output.DumpDestinationNotEmpty{} ->
                        pure ()
                    Left other ->
                        assertFailure
                            ("unexpected nonempty result: " <> show other)
                    Right _ ->
                        assertFailure "nonempty dump was accepted"
                assertBool "preflight did not create the default store"
                    . not
                    =<< Directory.doesPathExist
                        (cacheRoot Posix.</> "felix")

rejectsStoreCollisions :: Assertion
rejectsStoreCollisions =
    Temp.withSystemTempDirectory "felix-output-store-collision" \root -> do
        let dump = root Posix.</> "dump"
            persistentStore = dump Posix.</> "store.sqlite"
        Directory.createDirectory dump
        persistentPlan <- expectRightIO
            (Store.planStore
                (Store.ExplicitStore persistentStore))
        Store.withStoreLease persistentPlan \lease -> do
            result <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                (Just dump)
                Nothing
            expectCollision result

        freshPlan <- expectRightIO
            (Store.planStore Store.FreshTemporaryStore)
        Store.withStoreLease freshPlan \lease -> do
            let freshParent =
                    Posix.takeDirectory
                        (Store.storePathFilePath
                            (Store.storeLeasePath lease))
            result <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                (Just freshParent)
                Nothing
            expectCollision result

        relative <- expectRight (safeRelativePath "page.html")
        let htmlRoot = root Posix.</> "html"
            htmlStore = htmlRoot Posix.</> "page.html"
        Directory.createDirectory htmlRoot
        htmlPlan <- expectRightIO
            (Store.planStore
                (Store.ExplicitStore htmlStore))
        Store.withStoreLease htmlPlan \lease -> do
            result <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                Nothing
                (Just (htmlRoot, [relative]))
            expectCollision result

rejectsDumpHtmlCollisions :: Assertion
rejectsDumpHtmlCollisions =
    Temp.withSystemTempDirectory "felix-output-cross-collision" \root -> do
        let storeParent = root Posix.</> "store"
            storeFile = storeParent Posix.</> "store.sqlite"
            htmlRoot = root Posix.</> "html"
        Directory.createDirectory storeParent
        Directory.createDirectory htmlRoot
        relative <- expectRight (safeRelativePath "nested/page.html")
        plan <- expectRightIO
            (Store.planStore
                (Store.ExplicitStore storeFile))
        Store.withStoreLease plan \lease -> do
            result <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                (Just htmlRoot)
                (Just (htmlRoot, [relative]))
            expectCollision result

reservesRollbackJournal :: Assertion
reservesRollbackJournal =
    Temp.withSystemTempDirectory "felix-output-journal" \root -> do
        let storeParent = root Posix.</> "store"
            storeFile = storeParent Posix.</> "store.sqlite"
            journal = storeFile <> "-journal"
        Directory.createDirectory storeParent
        plan <- expectRightIO
            (Store.planStore
                (Store.ExplicitStore storeFile))
        Store.withStoreLease plan \lease -> do
            result <- Output.planVerificationOutputs
                (Store.storeLeasePath lease)
                (Just journal)
                Nothing
            case result of
                Left
                    (Output.CollidingOutputNamespaces
                        (Output.OutputNamespaceCollision
                            Output.StoreJournalOutputNamespace
                            reserved
                            Output.DumpOutputNamespace
                            requested :| [])) -> do
                                assertEqual "reserved journal" journal reserved
                                assertEqual "requested dump" journal requested
                Left other ->
                    assertFailure
                        ("unexpected journal collision: " <> show other)
                Right _ ->
                    assertFailure "store rollback journal was not reserved"

expectCollision
    :: Either Output.OutputPlanError Output.VerificationOutputPlan
    -> Assertion
expectCollision = \case
    Left Output.CollidingOutputNamespaces{} ->
        pure ()
    Left other ->
        assertFailure
            ("unexpected output-plan result: " <> show other)
    Right _ ->
        assertFailure "colliding output namespaces were accepted"

expectOutputRight
    :: Either Output.OutputPlanError Output.VerificationOutputPlan
    -> IO Output.VerificationOutputPlan
expectOutputRight = \case
    Left failure ->
        assertFailure (show failure) >> fail "unreachable"
    Right plan ->
        pure plan

expectRight :: Show failure => Either failure value -> IO value
expectRight = \case
    Left failure ->
        assertFailure (show failure) >> fail "unreachable"
    Right value ->
        pure value

expectRightIO
    :: Show failure
    => IO (Either failure value)
    -> IO value
expectRightIO action =
    expectRight =<< action

withEnvironment
    :: String
    -> String
    -> IO value
    -> IO value
withEnvironment name value action =
    Exception.bracket
        (Environment.lookupEnv name)
        restore
        \_previous -> do
            Environment.setEnv name value
            action
  where
    restore = \case
        Nothing ->
            Environment.unsetEnv name
        Just previous ->
            Environment.setEnv name previous