Merge pull request #63 from lamdera/copilot/fix-62

Add WebGL.Texture support for serialization and migration like File.File

Author: supermario

extra/Lamdera/Evergreen/Snapshot.hs

@@ -649,6 +649,7 @@ canonicalToFt version scope interfaces recursionSet canonical tvarMap =
 
         -- Kernel concessions for Frontend Model and Msg
         ("elm", "file", "File", "File") -> ("File.File", Set.singleton moduleName, Map.empty)
+        ("elm-explorations", "webgl", "WebGL.Texture", "Texture") -> ("WebGL.Texture.Texture", Set.singleton moduleName, Map.empty)
 
 
         -- @TODO improve; These aliases will show up as VirtualDom errors which might confuse users

extra/Lamdera/TypeHash.hs

@@ -275,7 +275,7 @@ canonicalToDiffableType targetName interfaces recursionSet canonical tvarMap =
         kernelErrorBrowserOnly =
           case identifier of
             (author, pkg, module_, tipe) ->
-              DError $ "must not contain the Frontent-only type `" <> tipe <> "` from " <> author <> "/" <> pkg <> ":" <> module_
+              DError $ "must not contain the Frontend-only type `" <> tipe <> "` from " <> author <> "/" <> pkg <> ":" <> module_
 
         lamderaCodecsError =
           case identifier of
@@ -394,6 +394,12 @@ canonicalToDiffableType targetName interfaces recursionSet canonical tvarMap =
           else
             kernelErrorBrowserOnly
 
+        ("elm-explorations", "webgl", "WebGL.Texture", "Texture") ->
+          if targetName `elem` ["FrontendMsg", "FrontendModel"] then
+            DKernelBrowser "WebGL.Texture.Texture"
+          else
+            kernelErrorBrowserOnly
+
         -- Lamdera codecs types shouldn't be used in the core type tree, as the core types must be serialisable,
         -- which means they need the auto-gen encoders/decoders, but those can only be generated by depending on
         -- qualified references to the lamdera/codecs module helpers.

extra/Lamdera/Wire3/Decoder.hs

@@ -350,6 +350,7 @@ decoderForType ifaces cname tipe =
 
     -- Frontend only JS reference types
     TType (Module.Canonical (Name "elm" "file") "File") "File" params -> callDecoder "decodeRef" tipe
+    TType (Module.Canonical (Name "elm-explorations" "webgl") "WebGL.Texture") "Texture" params -> callDecoder "decodeRef" tipe
 
 
     TType moduleName typeName params ->

extra/Lamdera/Wire3/Encoder.hs

@@ -214,6 +214,8 @@ encoderForType depth ifaces cname tipe =
     -- Frontend only JS reference types
     TType (Module.Canonical (Name "elm" "file") "File") "File" _ ->
       (a (VarForeign mLamdera_Wire "encodeRef" (Forall Map.empty (TLambda tipe tLamdera_Wire_Encoder))))
+    TType (Module.Canonical (Name "elm-explorations" "webgl") "WebGL.Texture") "Texture" _ ->
+      (a (VarForeign mLamdera_Wire "encodeRef" (Forall Map.empty (TLambda tipe tLamdera_Wire_Encoder))))
 
 
     TType moduleName typeName params ->

extra/Lamdera/Wire3/Helpers.hs

@@ -123,6 +123,7 @@ isUnsupportedKernelType tipe =
     -- JS types we are supporting through JS ref encodings. These serialisations
     -- CANNOT BE DECODED OUTSIDE OF THE JS SCOPE THEY WERE ENCODED IN!
     TType (Module.Canonical (Name "elm" "file") "File") "File" _ -> False
+    TType (Module.Canonical (Name "elm-explorations" "webgl") "WebGL.Texture") "Texture" _ -> False
 
 
     TAlias moduleName typeName tvars (Holey tipe) -> isUnsupportedKernelType tipe

test/Test.hs

@@ -21,11 +21,8 @@ import qualified Test.Ext.ElmPages.Check
 import qualified Test.TypeHashes
 import qualified Test.JsOutput
 import qualified Test.WebGL
-<<<<<<< HEAD
 import qualified Test.Lamdera.Live
-=======
 import qualified Test.BackwardsCompat
->>>>>>> bdcb71f7 (Test Lamdera HTML injections don't happen on vanilla Elm projects)
 
 import qualified Test.Lamdera.Evergreen.TestMigrationHarness
 import qualified Test.Lamdera.Evergreen.TestMigrationGenerator

test/Test/WebGL.hs

@@ -37,4 +37,28 @@ suite = tests
         actual <- catchOutput $ Lamdera.Compile.makeDev project [ "src/Triangle.elm" ]
 
         expectTextContains actual "Success! Compiled 1 module."
+
+
+  -- @TODO currently the type restriction checks only happen in lamdera check
+  -- We should probably move them to lamdera make now that we have the isLamdera detection
+  -- but that's a fair bit of work – so revisit these tests when that's done
+
+  , pending $ scope "compile Elm app with WebGL.Texture in FrontendModel" $ do
+        project <- io $ Lamdera.Relative.requireDir "test/scenario-webgl-texture"
+
+        _ <- io $ rmdir (project </> "elm-stuff")
+
+        actual <- catchOutput $ Lamdera.Compile.makeDev project [ "src/Frontend.elm", "src/Types.elm" ]
+
+        expectTextContains actual "Success! Compiled 3 modules."
+
+  , pending $ scope "compilation should fail with WebGL.Texture in backend contexts" $ do
+        project <- io $ Lamdera.Relative.requireDir "test/scenario-webgl-texture"
+
+        _ <- io $ rmdir (project </> "elm-stuff")
+
+        actual <- catchOutput $ Lamdera.Compile.makeDev project [ "src/Backend.elm" ]
+
+        -- Should fail with kernel error for browser-only types
+        expectTextContains actual "can only be used in the frontend"
   ]

test/scenario-webgl-texture/elm.json

@@ -0,0 +1,31 @@
+{
+    "type": "application",
+    "source-directories": [
+        "src"
+    ],
+    "elm-version": "0.19.1",
+    "dependencies": {
+        "direct": {
+            "elm/browser": "1.0.2",
+            "elm/core": "1.0.5",
+            "elm/html": "1.0.0",
+            "elm/json": "1.1.3",
+            "elm/url": "1.0.0",
+            "elm-explorations/linear-algebra": "1.0.3",
+            "elm-explorations/webgl": "1.1.3",
+            "lamdera/core": "1.0.0"
+        },
+        "indirect": {
+            "elm/bytes": "1.0.8",
+            "elm/file": "1.0.5",
+            "elm/http": "2.0.0",
+            "elm/time": "1.0.0",
+            "elm/virtual-dom": "1.0.4",
+            "lamdera/codecs": "1.0.0"
+        }
+    },
+    "test-dependencies": {
+        "direct": {},
+        "indirect": {}
+    }
+}

test/scenario-webgl-texture/src/Backend.elm

@@ -0,0 +1,43 @@
+module Backend exposing (..)
+
+import Lamdera exposing (ClientId, SessionId)
+import Types exposing (..)
+
+
+type alias Model =
+    BackendModel
+
+
+app =
+    Lamdera.backend
+        { init = init
+        , update = update
+        , updateFromFrontend = updateFromFrontend
+        , subscriptions = subscriptions
+        }
+
+
+init : ( Model, Cmd BackendMsg )
+init =
+    ( { message = "Hello from backend!", texture = Nothing }
+    , Cmd.none
+    )
+
+
+update : BackendMsg -> Model -> ( Model, Cmd BackendMsg )
+update msg model =
+    case msg of
+        NoOpBackendMsg ->
+            ( model, Cmd.none )
+
+
+updateFromFrontend : SessionId -> ClientId -> ToBackend -> Model -> ( Model, Cmd BackendMsg )
+updateFromFrontend sessionId clientId msg model =
+    case msg of
+        NoOpToBackend ->
+            ( model, Cmd.none )
+
+
+subscriptions : Model -> Sub BackendMsg
+subscriptions model =
+    Sub.none

test/scenario-webgl-texture/src/Frontend.elm

@@ -0,0 +1,73 @@
+module Frontend exposing (..)
+
+import Browser exposing (UrlRequest)
+import Browser.Navigation as Nav
+import Html
+import Url
+import WebGL.Texture as Texture
+import Lamdera
+import Types exposing (..)
+
+
+type alias Model = FrontendModel
+
+
+app =
+    Lamdera.frontend
+        { init = init
+        , onUrlRequest = UrlClicked
+        , onUrlChange = UrlChanged
+        , update = update
+        , updateFromBackend = updateFromBackend
+        , subscriptions = \m -> Sub.none
+        , view = view
+        }
+
+
+init : Url.Url -> Nav.Key -> ( Model, Cmd FrontendMsg )
+init url key =
+    ( { key = key
+      , texture = Nothing
+      }
+    , Cmd.none
+    )
+
+
+update : FrontendMsg -> Model -> ( Model, Cmd FrontendMsg )
+update msg model =
+    case msg of
+        UrlClicked urlRequest ->
+            case urlRequest of
+                Browser.Internal url ->
+                    ( model, Nav.pushUrl model.key (Url.toString url) )
+
+                Browser.External url ->
+                    ( model, Nav.load url )
+
+        UrlChanged url ->
+            ( model, Cmd.none )
+
+        TextureLoaded result ->
+            case result of
+                Ok texture ->
+                    ( { model | texture = Just texture }, Cmd.none )
+                
+                Err _ ->
+                    ( model, Cmd.none )
+
+        NoOpFrontendMsg ->
+            ( model, Cmd.none )
+
+
+updateFromBackend : ToFrontend -> Model -> ( Model, Cmd FrontendMsg )
+updateFromBackend msg model =
+    case msg of
+        NoOpToFrontend ->
+            ( model, Cmd.none )
+
+
+view : Model -> Browser.Document FrontendMsg
+view model =
+    { title = ""
+    , body = [ Html.text "Hello" ]
+    }