purescript-0.12.4: tests/TestBundle.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module TestBundle where

import Prelude ()
import Prelude.Compat

import qualified Language.PureScript as P
import Language.PureScript.Bundle 

import Data.Function (on)
import Data.List (minimumBy)

import qualified Data.Map as M

import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except

import System.Exit
import System.Process
import System.FilePath
import System.IO
import System.IO.UTF8
import qualified System.FilePath.Glob as Glob

import TestUtils
import Test.Tasty
import Test.Tasty.Hspec

main :: IO TestTree
main = testSpec "bundle" spec

spec :: Spec
spec = do
  (supportModules, supportExterns, supportForeigns) <- runIO $ setupSupportModules
  bundleTestCases <- runIO $ getTestFiles "bundle"
  outputFile <- runIO $ createOutputFile logfile 

  context "Bundle examples" $
    forM_ bundleTestCases $ \testPurs -> do
      it ("'" <> takeFileName (getTestMain testPurs) <> "' should compile, bundle and run without error") $
        assertBundles supportModules supportExterns supportForeigns testPurs outputFile
  where
  
  -- Takes the test entry point from a group of purs files - this is determined
  -- by the file with the shortest path name, as everything but the main file
  -- will be under a subdirectory.
  getTestMain :: [FilePath] -> FilePath
  getTestMain = minimumBy (compare `on` length)

assertBundles
  :: [P.Module]
  -> [P.ExternsFile]
  -> M.Map P.ModuleName FilePath
  -> [FilePath]
  -> Handle
  -> Expectation
assertBundles supportModules supportExterns supportForeigns inputFiles outputFile =
  assert supportModules supportExterns supportForeigns inputFiles checkMain $ \e ->
    case e of
      Left errs -> return . Just . P.prettyPrintMultipleErrors P.defaultPPEOptions $ errs
      Right _ -> do
        process <- findNodeProcess
        jsFiles <- Glob.globDir1 (Glob.compile "**/*.js") modulesDir
        let entryPoint = modulesDir </> "index.js"
        let entryModule = map (`ModuleIdentifier` Regular) ["Main"] 
        bundled <- runExceptT $ do
          input <- forM jsFiles $ \filename -> do
            js <- liftIO $ readUTF8File filename
            mid <- guessModuleIdentifier filename
            length js `seq` return (mid, Just filename, js) 
          bundleSM input entryModule (Just $ "Main") "PS" (Just entryPoint)
        case bundled of
            Right (_, js) -> do
              writeUTF8File entryPoint js
              result <- traverse (\node -> readProcessWithExitCode node [entryPoint] "") process
              hPutStrLn outputFile $ "\n" <> takeFileName (last inputFiles) <> ":"
              case result of
                Just (ExitSuccess, out, err)
                 | not (null err) -> return $ Just $ "Test wrote to stderr:\n\n" <> err
                 | not (null out) && trim (last (lines out)) == "Done" -> do
                     hPutStr outputFile out
                     return Nothing
                 | otherwise -> return $ Just $ "Test did not finish with 'Done':\n\n" <> out
                Just (ExitFailure _, _, err) -> return $ Just err
                Nothing -> return $ Just "Couldn't find node.js executable"
            Left err -> return . Just $ "Coud not bundle: " ++ show err

logfile :: FilePath
logfile = "bundle-tests.out"