SessionSpec.hs

module Unit.Tricorder.Daemon.Ghci.SessionSpec (test_Session) where

import Atelier.Effects.PubSub.Pub (Pub)
import Control.Exception (ErrorCall (..))
import Effectful (IOE, runEff)
import Effectful.Exception (try)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (assertBool, testCase, (@?=))

import Atelier.Effects.PubSub.Pub qualified as Pub
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set

import Tricorder.Build (BuildProgress, Diagnostic (..), Severity (..))
import Tricorder.Daemon.Ghci.Controls (Controls (..))
import Tricorder.Daemon.Ghci.LoadResult (LoadResult (..))
import Tricorder.Daemon.Ghci.Session (Session)
import Tricorder.Runtime (ProjectRoot (..))
import Tricorder.Session.Command.RenderedCommand (RenderedCommand (..))
import Tricorder.Session.Stage (Stage (..))

import Tricorder.Daemon.Ghci.Session qualified as Session


test_Session :: TestTree
test_Session =
    testGroup
        "Session"
        [ testGroup "runScripted" testScripted
        ]


--------------------------------------------------------------------------------
-- Scripted interpreter tests
--------------------------------------------------------------------------------

testScripted :: [TestTree]
testScripted =
    [ testGroup
        "withGhci"
        [ testGroup
            "initial load"
            [ testCase "returns scripted messages" do
                LoadResult {diagnostics = msgs} <-
                    runScripted [simpleResult [errMsg]]
                        $ Session.with Pub.publish cmd (ProjectRoot "/") \initial _ -> pure initial
                msgs @?= [errMsg]
            , testCase "returns empty list when scripted result has no messages" do
                LoadResult {diagnostics = msgs} <-
                    runScripted [simpleResult []]
                        $ Session.with Pub.publish cmd (ProjectRoot "/") \initial _ -> pure initial
                msgs @?= []
            , testCase "throws when scripted result is Left" do
                result <-
                    runScripted [Left (toException boom)]
                        $ try @ErrorCall
                        $ Session.with Pub.publish cmd (ProjectRoot "/") \initial _ -> pure initial
                result @?= Left boom
            ]
        , testGroup
            "reloading"
            [ testCase "returns scripted messages" do
                LoadResult {diagnostics = msgs} <-
                    runScripted [simpleResult [warnMsg], simpleResult [errMsg]]
                        $ Session.with Pub.publish cmd (ProjectRoot "/") \_ controls -> controls.reload
                msgs @?= [errMsg]
            , testCase "throws when scripted result is Left" do
                result <-
                    runScripted [Left (toException boom)]
                        $ try @ErrorCall
                        $ Session.with Pub.publish cmd (ProjectRoot "/") \_ controls -> controls.reload
                result @?= Left boom
            ]
        ]
    , testGroup
        "sequencing"
        [ testCase "consumes results in order across mixed operations" do
            (a, b) <- runScripted [simpleResult [errMsg], simpleResult [warnMsg]] do
                Session.with Pub.publish cmd (ProjectRoot "/") \LoadResult {diagnostics = a} controls -> do
                    LoadResult {diagnostics = b} <- controls.reload
                    pure (a, b)
            a @?= [errMsg]
            b @?= [warnMsg]
        , testCase "recover scenario: error then success" do
            result <- runScripted [Left (toException boom), simpleResult []] do
                r1 <- try @ErrorCall $ Session.with Pub.publish cmd (ProjectRoot "/") \i _ -> pure i
                LoadResult {diagnostics = r2} <- Session.with Pub.publish cmd (ProjectRoot "/") \i _ -> pure i
                pure (r1, r2)
            assertBool "expected Left" $ isLeft (fst result)
            snd result @?= []
        ]
    ]


--------------------------------------------------------------------------------
-- Helpers
--------------------------------------------------------------------------------

cmd :: RenderedCommand 'Build
cmd = RenderedCommand "cabal repl lib:foo"


boom :: ErrorCall
boom = ErrorCall "simulated GHCi crash"


errMsg :: Diagnostic
errMsg =
    Diagnostic
        { severity = SError
        , file = "src/Foo.hs"
        , line = 1
        , col = 1
        , endLine = 1
        , endCol = 5
        , title = "Variable not in scope: foo"
        , text = "Variable not in scope: foo"
        }


warnMsg :: Diagnostic
warnMsg =
    Diagnostic
        { severity = SWarning
        , file = "src/Bar.hs"
        , line = 10
        , col = 3
        , endLine = 10
        , endCol = 8
        , title = "Unused import"
        , text = "Unused import"
        }


-- | Convenience constructor: a scripted result with no compiled-file info.
simpleResult :: [Diagnostic] -> Either SomeException LoadResult
simpleResult msgs =
    Right
        LoadResult
            { moduleCount = 0
            , compiledFiles = Set.empty
            , loadedModules = Map.empty
            , targetNames = []
            , diagnostics = msgs
            }


runScripted
    :: [Either SomeException LoadResult]
    -> Eff '[Session, Pub BuildProgress, IOE] a
    -> IO a
runScripted results = runEff . Pub.runNoOp . Session.runScripted results