reflex-ghci-0.2.0.0: tests/test.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

import Control.Monad
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as Map
import Reflex
import Reflex.Host.Headless (runHeadlessApp)
import System.Directory (copyFile, getCurrentDirectory, withCurrentDirectory)
import System.IO.Temp (withSystemTempDirectory)
import qualified System.Process as P
import qualified Data.ByteString.Char8 as C8

import Reflex.Process.GHCi

ghciExe :: FilePath
ghciExe = "ghci"

data ExitStatus = Succeeded | Failed String
  deriving (Eq, Show)

main :: IO ()
main = do
  runHeadlessApp $ do
    pb <- getPostBuild
    rec
      r <- ghci (P.shell ghciExe) expr never never
      let expr = commands 
            [ ":l tests/exe-pkg/Main.hs"
            , "main"
            , ":l tests/lib-pkg-err/src/MyLib/One.hs tests/lib-pkg-err/src/MyLib/Two.hs tests/lib-pkg-err/src/MyLib/Three.hs tests/lib-pkg-err/src/MyLib.hs"
            , ":l tests/lib-pkg/src/MyLib/One.hs tests/lib-pkg/src/MyLib/Two.hs tests/lib-pkg/src/MyLib/Three.hs tests/lib-pkg/src/MyLib.hs"
            , "import MyLib"
            , "err"
            , "notFound"
            , "done"
            , ":q"
            ] <$ pb
      results <- foldDyn Map.union Map.empty $ _repl_finished r
      performEvent_ $ ffor (tagPromptlyDyn results (_repl_exited r)) $ \o -> do
        liftIO $ print o
        liftIO $ putStrLn "Simple tests with no reloading or interrupts:"
        r1 <- assertStdoutEq "Load and run package (exe-pkg/Main.hs:main)" (Map.lookup 10 o) "Hello, Haskell!"
        r2 <- assertStderr "Fail to load package (lib-pkg-err)" (Map.lookup 11 o) (C8.isInfixOf "Multiple declarations" . unLines)
        r3 <- assertStdout "Load package (lib-pkg)" (Map.lookup 12 o) (C8.isInfixOf "Ok, four modules loaded" . unLines)
        r4 <- assertCmd "Exception (lib-pkg/src/MyLib.hs:err)" (Map.lookup 14 o) hasErrors
        r5 <- assertCmd "Variable not in scope (lib-pkg/src/MyLib.hs:notFound)" (Map.lookup 15 o) hasErrors
        r6 <- assertStdoutEq "Expression completed (lib-pkg/src/MyLib.hs:done)" (Map.lookup 16 o) "done"
        when (not . and $ [r1, r2, r3, r4, r5, r6]) $ error "Tests failed"
    pure $ () <$ _repl_exited r
  testRepl
  watchAndReloadTest

watchAndReloadTest :: IO ()
watchAndReloadTest = withSystemTempDirectory "reflex-ghci-test" $ \p -> do
  putStrLn "watchAndReloadTest:"
  src <- getCurrentDirectory
  P.callProcess "cp" ["-r", src <> "/tests/lib-pkg-err", p]
  let cmd = P.proc ghciExe ["-i" <> p <> "/lib-pkg-err/src", "MyLib"]
  withCurrentDirectory p $ runHeadlessApp $ do
    g <- ghciWatch cmd (Just (unsafeCommand ":q")) never never
    loadFailedDelayed <- debounce 0.5 $ ffilter id $ updated $ ffor (_repl_started g) $ \case
      (_, Nothing) -> True
      _ -> False

    performEvent_ $ ffor loadFailedDelayed $ \_ -> liftIO $ do
      putStrLn "copying fixed file"
      copyFile (src <> "/tests/lib-pkg/src/MyLib/Three.hs")
               (p <> "/lib-pkg-err/src/MyLib/Three.hs")

    output <- foldDyn Map.union Map.empty $ _repl_finished g

    performEvent $ ffor (tagPromptlyDyn output (_repl_exited g)) $ \o -> do
      r1 <- assertCmd "Failed to load file" (Map.lookup 8 o) hasErrors
      r2 <- assertCmd "Changed file detected and loaded" (Map.lookup 9 o) (not . hasErrors)
      when (not . and $ [r1, r2]) $ error "Test failed"