Support lamdera/program-test test recording from devbar

builder/src/Deps/Registry.hs

@@ -255,7 +255,7 @@ lamderaCoreDeps =
     [ (Lamdera.Project.lamderaCodecs, KnownVersions { _newest = V.Version 1 0 0, _previous = [] })
     , (Lamdera.Project.lamderaCore, KnownVersions { _newest = V.Version 1 0 0, _previous = [] })
     , (Lamdera.Project.lamderaContainers, KnownVersions { _newest = V.Version 1 0 0, _previous = [] })
-    , (Lamdera.Project.lamderaProgramTest, KnownVersions { _newest = V.Version 3 0 0, _previous = [ V.Version 1 0 0, V.Version 2 0 0] })
+    , (Lamdera.Project.lamderaProgramTest, KnownVersions { _newest = V.Version 4 0 0, _previous = [ V.Version 1 0 0, V.Version 2 0 0, V.Version 3 0 0 ] })
     , (Lamdera.Project.lamderaWebsocket, KnownVersions { _newest = V.Version 1 0 0, _previous = [] })
     , (Lamdera.Project.lamderaFusion, KnownVersions { _newest = V.Version 1 0 0, _previous = [] })
     ]

extra/Lamdera/CLI/Live.hs

@@ -131,9 +131,14 @@ serveUnmatchedUrlsToIndex root serveElm =
       serveElm (lamderaCache root </> "LocalDev.elm")
 
 
-prepareLocalDev :: FilePath -> IO FilePath
-prepareLocalDev root = do
-  overrideM <- Lamdera.Relative.readFile "extra/LocalDev/LocalDev.elm"
+prepareLocalDev :: Bool -> FilePath -> IO FilePath
+prepareLocalDev useProgramTestOverrides root = do
+  overrideM <-
+    Lamdera.Relative.readFile $
+        if useProgramTestOverrides then
+            "extra/LocalDev/LocalDevProgramTest.elm"
+        else
+            "extra/LocalDev/LocalDev.elm"
   let
     cache = lamderaCache root
     harnessPath = cache </> "LocalDev.elm"
@@ -155,7 +160,7 @@ prepareLocalDev root = do
 
     Nothing ->
       writeIfDifferent harnessPath
-        (lamderaLocalDev
+        ((if useProgramTestOverrides then lamderaLocalDevProgramTest else lamderaLocalDev)
           & replaceVersionMarker
           & replaceRpcMarker rpcExists
         )
@@ -210,6 +215,11 @@ lamderaLocalDev =
   T.decodeUtf8 $(bsToExp =<< runIO (Lamdera.Relative.readByteString "extra/LocalDev/LocalDev.elm"))
 
 
+lamderaLocalDevProgramTest :: Text
+lamderaLocalDevProgramTest =
+  T.decodeUtf8 $(bsToExp =<< runIO (Lamdera.Relative.readByteString "extra/LocalDev/LocalDevProgramTest.elm"))
+
+
 refreshClients (mClients, mLeader, mChan, beState) =
   SocketServer.broadcastImpl mClients "{\"t\":\"r\"}" -- r is refresh, see live.js
 

extra/Lamdera/Injection.hs

@@ -29,8 +29,11 @@ import qualified Elm.Package as Pkg
 import qualified Elm.ModuleName as ModuleName
 import qualified AST.Optimized as Opt
 import qualified Elm.Kernel
+import qualified Elm.Outline
+import qualified Elm.Version
 
 import Lamdera
+import qualified Lamdera.Project
 import qualified Lamdera.Relative
 import StandaloneInstances
 import qualified Ext.Common
@@ -798,6 +801,7 @@ elmPkgJs mode =
         includesPathM <- Lamdera.Relative.findFile $ root </> "elm-pkg-js-includes.js"
         esbuildConfigPathM <- Lamdera.Relative.findFile $ root </> "esbuild.config.js"
         esbuildPathM <- Dir.findExecutable "esbuild"
+        elmJson <- Elm.Outline.read root True
 
         case (esbuildConfigPathM, esbuildPathM, includesPathM) of
           (Just esbuildConfigPath, _, _) ->
@@ -819,21 +823,38 @@ elmPkgJs mode =
                     error "no min file after compile, run `node esbuild.config.js` to check errors"
               else do
                 Lamdera.debug_ "🏗️🟠  Using dumbJsPackager, ignoring esbuild.config.js in non-dev mode"
-                dumbJsPackager root elmPkgJsSources
+                dumbJsPackager (useProgramTestOverrides elmJson) root elmPkgJsSources
           (_, Just esbuildPath, Just includesPath) ->
             if Ext.Common.isDebug_
               then do
                 esbuildIncluder root esbuildPath includesPath
               else do
                 Lamdera.debug_ "🏗️🟠  Using dumbJsPackager, ignoring esbuild in non-dev mode"
-                dumbJsPackager root elmPkgJsSources
+                dumbJsPackager (useProgramTestOverrides elmJson) root elmPkgJsSources
           _ -> do
             Lamdera.debug_ "🏗️  Using dumbJsPackager"
-            dumbJsPackager root elmPkgJsSources
+            dumbJsPackager (useProgramTestOverrides elmJson) root elmPkgJsSources
     _ ->
       ""
 
 
+useProgramTestOverrides :: Either a Elm.Outline.Outline -> Bool
+useProgramTestOverrides elmJson =
+    case elmJson of
+        Right (Elm.Outline.App (Elm.Outline.AppOutline _ _ direct _ _ _)) ->
+            case Map.lookup Lamdera.Project.lamderaProgramTest direct of
+                Just (Elm.Version.Version major _ _) ->
+                    if major >= 4 then
+                        True
+                    else
+                        False
+
+                Nothing ->
+                    False
+        _ ->
+            False
+
+
 esbuildIncluder :: FilePath -> FilePath -> FilePath -> IO B.Builder
 esbuildIncluder root esbuildPath includesPath = do
   minFile <- Lamdera.Relative.readFile $ root </> "elm-pkg-js-includes.min.js"
@@ -869,11 +890,14 @@ esbuildIncluder root esbuildPath includesPath = do
   --   )
 
 
+lamderaTestRecordingJs :: Text
+lamderaTestRecordingJs =
+  Text.decodeUtf8 $(bsToExp =<< runIO (Lamdera.Relative.readByteString "extra/test-recording.js"))
 
 
 -- Tries to be clever by injecting `{}` as the `exports` value. Falls over if the target files have been compiled
 -- by a packager or if they don't use the `export.init` syntax, i.e. `export async function init() {...}`
-dumbJsPackager root elmPkgJsSources = do
+dumbJsPackager addTestRecording root elmPkgJsSources = do
   wrappedPkgImports <-
     mapM
       (\f ->
@@ -888,7 +912,14 @@ dumbJsPackager root elmPkgJsSources = do
       elmPkgJsSources
 
   pure $ B.byteString $ mconcat
-    [ "const pkgExports = {\n" <> mconcat wrappedPkgImports <> "\n}\n"
+    [ "const pkgExports = {\n"
+        <> mconcat wrappedPkgImports
+        <> (if addTestRecording then
+               "'program-test-recording.js': function(exports){\n" <> Text.encodeUtf8 lamderaTestRecordingJs <> "\nreturn exports;},\n"
+           else
+               ""
+           )
+        <> "\n}\n"
     , "if (typeof window !== 'undefined') {"
     , "  window.elmPkgJsIncludes = {"
     , "    init: async function(app) {"

extra/LocalDev/LocalDevProgramTest.elm

@@ -0,0 +1,182 @@
+port module LocalDev exposing (main)
+
+{-
+
+   Hello you curious thing!
+
+   This is the development harness used for local development of Lamdera apps.
+
+   This file should not be used as a reference for building Lamdera apps, see
+   https://dashboard.lamdera.app/docs/building instead.
+
+   The features used by this file are subject to change/removal and should not
+   be relied on in any way.
+
+-}
+
+import Backend
+import Effect.LocalDev exposing (ConnectionMsg, Msg(..), WireMsg)
+import Env
+import Frontend
+import Json.Encode
+import Lamdera exposing (ClientId, Key, SessionId, Url)
+import Lamdera.Json as Json
+import Lamdera.Wire3 exposing (Bytes)
+import LamderaRPC
+import RPC
+import Types
+
+
+{-| Injected when parsed by Lamdera/CLI/Live.hs
+-}
+currentVersion =
+    ( 0, 0, 0 )
+
+
+port send_ToBackend : Bytes -> Cmd msg
+
+
+port receive_ToBackend : (( SessionId, ClientId, Bytes ) -> msg) -> Sub msg
+
+
+port save_BackendModel : { t : String, f : Bool, b : Bytes } -> Cmd msg
+
+
+port send_EnvMode : { t : String, v : String } -> Cmd msg
+
+
+port send_ToFrontend : WireMsg -> Cmd msg
+
+
+port receive_ToFrontend : (WireMsg -> msg) -> Sub msg
+
+
+
+-- @TODO this isn't used currently but needs to adapt for state restore functions?
+
+
+port receive_BackendModel : (Bytes -> msg) -> Sub msg
+
+
+
+-- @LEGCACY END
+
+
+port setNodeTypeLeader : (Bool -> msg) -> Sub msg
+
+
+port setLiveStatus : (Bool -> msg) -> Sub msg
+
+
+port setClientId : (String -> msg) -> Sub msg
+
+
+port rpcIn : (Json.Value -> msg) -> Sub msg
+
+
+port rpcOut : Json.Value -> Cmd msg
+
+
+port onConnection : (ConnectionMsg -> msg) -> Sub msg
+
+
+port onDisconnection : (ConnectionMsg -> msg) -> Sub msg
+
+
+port localDevGotEvent : (Json.Encode.Value -> msg) -> Sub msg
+
+
+port localDevStartRecording : () -> Cmd msg
+
+
+port localDevStopRecording : () -> Cmd msg
+
+
+port localDevCopyToClipboard : String -> Cmd msg
+
+
+main =
+    let
+        _ =
+            shouldProxy
+    in
+    Effect.LocalDev.localDev
+        { send_ToBackend = send_ToBackend
+        , receive_ToBackend = receive_ToBackend
+        , save_BackendModel = save_BackendModel
+        , send_EnvMode = send_EnvMode
+        , send_ToFrontend = send_ToFrontend
+        , receive_ToFrontend = receive_ToFrontend
+        , receive_BackendModel = receive_BackendModel
+        , setNodeTypeLeader = setNodeTypeLeader
+        , setLiveStatus = setLiveStatus
+        , setClientId = setClientId
+        , rpcIn = rpcIn
+        , mkrrc = mkrrc
+        , onConnection = onConnection
+        , onDisconnection = onDisconnection
+        , localDevGotEvent = localDevGotEvent
+        , localDevStartRecording = localDevStartRecording
+        , localDevStopRecording = localDevStopRecording
+        , localDevCopyToClipboard = localDevCopyToClipboard
+        , currentVersion = currentVersion
+        , w3_encode_BackendModel = Types.w3_encode_BackendModel
+        , w3_decode_BackendModel = Types.w3_decode_BackendModel
+        , w3_encode_ToFrontend = Types.w3_encode_ToFrontend
+        , w3_decode_ToFrontend = Types.w3_decode_ToFrontend
+        , w3_encode_ToBackend = Types.w3_encode_ToBackend
+        , w3_decode_ToBackend = Types.w3_decode_ToBackend
+        , envMeta =
+            case Env.mode of
+                Env.Production ->
+                    ( "Prod", "#E06C75" )
+
+                Env.Development ->
+                    ( "Dev", "#85BC7A" )
+        , userFrontendApp = Frontend.app
+        , userBackendApp = Backend.app
+        }
+
+
+mkrrc m rpcArgsJson =
+    let
+        log t v =
+            if m.devbar.logging then
+                Debug.log t v
+
+            else
+                v
+    in
+    -- The case expression is just so we have the right amount of tabbing for the code insertion
+    case () of
+        () ->
+            -- MKRRC
+            ( m, Cmd.none )
+
+
+
+-- -}
+
+
+{-| Used directly by the core CORS modification to decide which Msg types need
+
+the CORS flag set for subsequent Cmd's they'll initiate
+
+-}
+shouldProxy : Msg frontendMsg backendMsg toFrontend toBackend -> Bool
+shouldProxy msg =
+    case msg of
+        BEMsg _ ->
+            True
+
+        FEtoBE _ ->
+            True
+
+        FEtoBEDelayed _ ->
+            True
+
+        ReceivedToBackend _ ->
+            True
+
+        _ ->
+            False