{- HLINT ignore "Redundant do" -} {-# LANGUAGE GADTs #-} {-# LANGUAGE PartialTypeSignatures #-} module Axel.Test.Haskell.StackSpec where import Axel.Prelude import Axel.Eff.Error import Axel.Eff.FileSystem as FS import Axel.Eff.Process import Axel.Haskell.Stack as Stack import Axel.Test.Eff.ConsoleMock as Mock import Axel.Test.Eff.FileSystemMock as Mock import Axel.Test.Eff.ProcessMock as Mock import Control.Lens import qualified Data.Map as M import qualified Polysemy as Sem import qualified Polysemy.Error as Sem import System.Exit import Test.Tasty.Hspec import TestUtils spec_Stack :: SpecWith () spec_Stack = do describe "addStackDependency" $ do it "adds a Stackage dependency to a Stack project" $ do let action = Stack.addStackDependency "foo-1.2.3.4" (FilePath "project/path") let origFSState = Mock.mkFileSystemState [ Mock.Directory (FilePath "project") [ Mock.Directory (FilePath "path") [ Mock.File (FilePath "package.yaml") "dependencies:\n- asdf-5.6.7" ] ] ] let expectedFSState = origFSState & Mock.fsRoot . at (FilePath "project/path/package.yaml") ?~ Mock.File (FilePath "package.yaml") "dependencies:\n- foo-1.2.3.4\n- asdf-5.6.7\n" case Sem.run . Sem.runError . Mock.runFileSystem origFSState $ action of Left err -> failSpec err Right (result, ()) -> result `shouldBe` expectedFSState describe "buildStackProject" $ do it "builds a Stack project" $ do let action = Stack.buildStackProject M.empty (FilePath "project/foo") let origConsoleState = Mock.mkConsoleState let origFSState = Mock.mkFileSystemState [ Mock.Directory (FilePath "project") [Mock.Directory (FilePath "foo") []] ] let origProcState = Mock.mkProcessState [] [ProcessResult ((ExitSuccess, Just ("", "")), pure ())] let expectation result (consoleState, fsState, procState) = do result `shouldBe` () consoleState ^. Mock.consoleOutput `shouldBe` "Building foo...\n" procState ^. Mock.procExecutionLog `shouldBe` [("stack build --ghc-options='-ddump-json'", Just "")] fsState ^. Mock.fsCurrentDirectory `shouldBe` FilePath "/" case Sem.run . Sem.runError @Error . Sem.runError @Text . Mock.runFileSystem origFSState . Mock.runProcess origProcState . Mock.runConsole origConsoleState $ action of Left err -> failSpec $ renderError err Right (Left err) -> failSpec err Right (Right (fsState, (procState, (consoleState, x)))) -> expectation x (consoleState, fsState, procState) describe "createStackProject" $ do it "creates a new Stack project" $ do let action = Stack.createStackProject "newProject" let origFSState = Mock.mkFileSystemState [] let origProcState = Mock.mkProcessState [] [ ProcessResult ( (ExitSuccess, Just ("", "")) , FS.createDirectoryIfMissing False (FilePath "newProject")) , ProcessResult ((ExitSuccess, Just ("", "")), pure ()) ] let expectation result (fsState, procState) = do result `shouldBe` () procState ^. Mock.procExecutionLog `shouldBe` [ ("stack new newProject new-template", Just "") , ( "stack config set resolver " <> stackageResolverWithAxel , Just "") ] fsState ^. Mock.fsCurrentDirectory `shouldBe` FilePath "/" fsState ^. Mock.fsRoot . at (FilePath "newProject") . _Just . Mock.fsPath `shouldBe` FilePath "newProject" case Sem.run . Sem.runError @Error . Sem.runError @Text . Mock.runFileSystem origFSState . Mock.runProcess origProcState $ action of Left err -> failSpec $ renderError err Right (Left err) -> failSpec err Right (Right (fsState, (procState, x))) -> expectation x (fsState, procState) describe "runStackProject" $ do it "runs a Stack project" $ do let action = Stack.runStackProject (FilePath "project/foo") let origConsoleState = Mock.mkConsoleState let origFSState = Mock.mkFileSystemState [ Mock.Directory (FilePath "project") [Mock.Directory (FilePath "foo") []] ] let origProcState = Mock.mkProcessState [] [ ProcessResult ( ( ExitSuccess , Just ("", "foo:lib\nfoo:exe:foo-exe\nfoo:test:foo-test")) , pure ()) , ProcessResult ((ExitSuccess, Nothing), pure ()) ] let expectation result (consoleState, fsState, procState) = do result `shouldBe` () procState ^. Mock.procExecutionLog `shouldBe` [("stack ide targets", Just ""), ("stack exec foo-exe", Nothing)] fsState ^. Mock.fsCurrentDirectory `shouldBe` FilePath "/" consoleState ^. Mock.consoleOutput `shouldBe` "Running foo-exe...\n" case Sem.run . Sem.runError @Error . Sem.runError @Text . Mock.runFileSystem origFSState . Mock.runProcess origProcState . Mock.runConsole origConsoleState $ action of Left err -> failSpec $ renderError err Right (Left err) -> failSpec err Right (Right (fsState, (procState, (consoleState, x)))) -> expectation x (consoleState, fsState, procState) describe "compileFile" $ do it "compiles a file with GHC" $ do let action = Stack.compileFile @'CreateStreams (FilePath "projectFoo/app/Main.hs") "" let origFSState = Mock.mkFileSystemState [] let origProcState = Mock.mkProcessState [] [ProcessResult ((ExitSuccess, Just ("testStdout", "")), pure ())] let expectation stdout (procState, _) = do stdout `shouldBe` "testStdout" procState ^. Mock.procExecutionLog `shouldBe` [ ( "stack ghc --resolver " <> Stack.stackageResolverWithAxel <> " --package " <> Stack.axelStackageId <> " -- projectFoo/app/Main.hs" , Just "") ] case Sem.run . Sem.runError @Text . Mock.runFileSystem origFSState . Mock.runProcess origProcState $ action of Left err -> failSpec err Right (fsState, (procState, (_, stdout, _))) -> expectation stdout (procState, fsState) describe "interpretFile" $ do it "interprets a file with GHC" $ do let action = Stack.interpretFile @'CreateStreams (FilePath "projectFoo/app/Main.hs") "" let origFSState = Mock.mkFileSystemState [] let origProcState = Mock.mkProcessState [] [ProcessResult ((ExitSuccess, Just ("testStdout", "")), pure ())] let expectation stdout (procState, _) = do stdout `shouldBe` "testStdout" procState ^. Mock.procExecutionLog `shouldBe` [ ( "stack runghc --resolver " <> Stack.stackageResolverWithAxel <> " --package " <> Stack.axelStackageId <> " -- projectFoo/app/Main.hs" , Just "") ] case Sem.run . Sem.runError @Text . Mock.runFileSystem origFSState . Mock.runProcess origProcState $ action of Left err -> failSpec err Right (fsState, (procState, (_, stdout, _))) -> expectation stdout (procState, fsState)