Bundle code via esbuild after remapping imports

Author: JordanMartinez

client/src/Try/API.purs

@@ -6,6 +6,7 @@ module Try.API
   , Suggestion(..)
   , SuccessResult(..)
   , FailedResult(..)
+  , BundleResult
   , CompileResult(..)
   , get
   , compile
@@ -69,24 +70,31 @@ type CompileWarning =
   }
 
 type SuccessResult =
-  { js :: String
+  { unbundled :: String
+  , bundled :: String
   , warnings :: Maybe (Array CompileWarning)
   }
 
 type FailedResult =
   { error :: CompileError
   }
 
+type BundleResult =
+  { bundleFailed :: String
+  }
+
 -- | The result of calling the compile API.
 data CompileResult
   = CompileSuccess SuccessResult
   | CompileFailed FailedResult
+  | BundleFailed BundleResult
 
 -- | Parse the result from the compile API and verify it
 instance decodeJsonCompileResult :: DecodeJson CompileResult where
   decodeJson json =
     map CompileSuccess (decodeJson json)
       <|> map CompileFailed (decodeJson json)
+      <|> map BundleFailed (decodeJson json)
 
 get :: URL -> ExceptT String Aff String
 get url = ExceptT $ AX.get AXRF.string url >>= case _ of
@@ -102,8 +110,8 @@ compile :: forall m. MonadAff m => String -> String -> ExceptT String m (Either
 compile endpoint code = ExceptT $ liftAff $ AX.post AXRF.json (endpoint <> "/compile") requestBody >>= case _ of
   Left e ->
     pure $ Left $ printError e
-  Right { status } | status >= StatusCode 400 ->
-    pure $ Left $ "Received error status code: " <> show status
+  Right { status, statusText } | status >= StatusCode 400 ->
+    pure $ Left $ "Received error status code: " <> show status <> " | " <> statusText
   Right { body } ->
     pure $ Right $ decodeJson body
   where

client/src/Try/Container.purs

@@ -6,15 +6,11 @@ import Ace (Annotation)
 import Control.Monad.Except (runExceptT)
 import Data.Array (fold)
 import Data.Array as Array
-import Data.Either (Either(..), either)
+import Data.Either (Either(..))
 import Data.Foldable (for_, oneOf)
 import Data.FoldableWithIndex (foldMapWithIndex)
 import Data.Maybe (Maybe(..), fromMaybe, isNothing)
 import Data.Symbol (SProxy(..))
-import Data.String as String
-import Data.String (Pattern(..))
-import Data.String.Regex as Regex
-import Data.String.Regex.Flags as RegexFlags
 import Effect (Effect)
 import Effect.Aff (Aff, makeAff)
 import Effect.Aff as Aff
@@ -24,7 +20,6 @@ import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
 import Halogen.HTML.Properties as HP
-import Partial.Unsafe (unsafeCrashWith)
 import Try.API (CompileError(..), CompileResult(..), CompilerError, ErrorPosition)
 import Try.API as API
 import Try.Config as Config
@@ -168,6 +163,10 @@ component = H.mkComponent
           H.liftEffect $ error err
           H.modify_ _ { compiled = Just (Left err) }
 
+        Right (Right res@(BundleFailed _)) -> do
+          H.liftEffect teardownIFrame
+          H.modify_ _ { compiled = Just (Right res) }
+
         Right (Right res@(CompileFailed { error })) -> do
           H.liftEffect teardownIFrame
           H.modify_ _ { compiled = Just (Right res) }
@@ -182,7 +181,7 @@ component = H.mkComponent
                   _ <- H.query _editor unit $ H.tell $ Editor.AddMarker MarkerError pos
                   pure unit
 
-        Right (Right res@(CompileSuccess { js, warnings })) -> do
+        Right (Right res@(CompileSuccess { bundled, unbundled, warnings })) -> do
           { settings } <- H.get
           if settings.showJs then
             H.liftEffect teardownIFrame
@@ -192,20 +191,7 @@ component = H.mkComponent
               _ <- H.query _editor unit $ H.tell $ Editor.SetAnnotations anns
               pure unit
             let
-              importRegex :: Regex.Regex
-              importRegex = either (\_ -> unsafeCrashWith "Invalid regex") identity
-                $ Regex.regex """^import (.+) from "../([^"]+)";$""" RegexFlags.noFlags
-              replacement = "import $1 from \"" <> Config.loaderUrl <> "/$2\";"
-              codeFixImports = js
-                # String.split (Pattern "\n")
-                # map (Regex.replace importRegex replacement)
-              finalCode = String.joinWith "\n" $ codeFixImports <>
-                [ ""
-                , ""
-                , "main();" -- actually call the `main` function
-                ]
-
-              eventData = { code: finalCode }
+              eventData = { code: bundled }
             H.liftEffect teardownIFrame
             H.liftAff $ makeAff \f -> do
               runEffectFn3 setupIFrame eventData (f (Right unit)) (f (Left $ Aff.error "Could not load iframe"))
@@ -396,14 +382,16 @@ component = H.mkComponent
       Left err ->
         renderPlaintext err
       Right res -> case res of
+        BundleFailed { bundleFailed } -> do
+            renderPlaintext bundleFailed
         CompileFailed { error } -> case error of
           OtherError err ->
             renderPlaintext err
           CompilerErrors errs ->
             HH.div_ $ renderCompilerErrors errs
-        CompileSuccess { js } ->
+        CompileSuccess { unbundled } ->
           whenElem state.settings.showJs \_ ->
-            renderPlaintext js
+            renderPlaintext unbundled
 
 whenElem :: forall w i. Boolean -> (Unit -> HH.HTML w i) -> HH.HTML w i
 whenElem cond f = if cond then f unit else HH.text ""

server/Main.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Main (main) where
 
@@ -28,6 +29,7 @@ import qualified Data.Map as M
 import           Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy.Encoding as TLE
 import           Data.Time.Clock (UTCTime)
 import           GHC.Generics (Generic)
 import qualified Language.PureScript as P
@@ -44,11 +46,15 @@ import qualified Language.PureScript.Make.Cache as Cache
 import qualified Language.PureScript.TypeChecker.TypeSearch as TS
 import qualified Network.Wai.Handler.Warp as Warp
 import           System.Environment (getArgs)
-import           System.Exit (exitFailure)
+import           System.Exit (exitFailure, ExitCode (ExitSuccess))
 import           System.FilePath.Glob (glob)
 import qualified System.IO as IO
 import           Web.Scotty
 import qualified Web.Scotty as Scotty
+import           Text.RE.TDFA.Text (ed, (?=~/), compileSearchReplace)
+import           System.Process.Typed (readProcess, byteStringInput, byteStringOutput, setStdout, proc, setStdin)
+import           Data.Text.Encoding (encodeUtf8)
+import           Text.RE.TDFA (re, (*=~), matches)
 
 type JS = Text
 
@@ -159,8 +165,36 @@ server externs initNamesEnv initEnv port = do
       case response of
         Left err ->
           Scotty.json $ A.object [ "error" .= err ]
-        Right (warnings, comp) ->
-          Scotty.json $ A.object [ "js" .= comp, "warnings" .= warnings ]
+        Right (warnings, comp) -> do
+          regex <- compileSearchReplace "^import (.+) from \"../([^\"]+)\";$" "import $1 from \"./output/$2\";"
+          let
+            fixImports :: Text -> Text
+            fixImports s = s ?=~/ regex
+            callMainWrapper :: Text -> Text
+            callMainWrapper s = s <> "\n\nmain();"
+            codeWithImportsFixed = callMainWrapper $ T.unlines $ fixImports <$> T.lines comp
+            esbuild =
+              setStdin (byteStringInput $ BL.fromStrict $ T.encodeUtf8 codeWithImportsFixed)
+                $ setStdout byteStringOutput
+                $ proc "esbuild"
+                    [ "--bundle"
+                    , "--platform=browser"
+                    , "--format=esm"
+                    , "--external:big-integer"
+                    , "--external:decimal.js"
+                    , "--external:react"
+                    , "--external:react-dom"
+                    , "--external:react-dom/server"
+                    , "--external:uuid"
+                    ]
+
+          (exitCode, out, err) <- readProcess esbuild
+          case exitCode of
+            ExitSuccess -> do
+              let bundled = T.decodeUtf8 $ BL.toStrict out
+              Scotty.json $ A.object [ "unbundled" .= comp, "bundled" .= bundled, "warnings" .= warnings ]
+            _ -> do
+              Scotty.json $ A.object [ "bundleFailed" .= T.decodeUtf8 (BL.toStrict err) ]
 
     get "/search" $ do
       query <- param "q"

trypurescript.cabal

@@ -31,8 +31,10 @@ executable trypurescript
                    http-types -any,
                    transformers -any,
                    mtl -any,
+                   regex -any,
                    text -any,
                    time -any,
+                   typed-process -any,
                    warp -any
     hs-source-dirs: server
     main-is: Main.hs