Add possibility to edit css code

README.md

@@ -57,6 +57,7 @@ You can add three types of entries:
 
 - label: Name to display in the menu item
 - fsharpCode: Relative url of the F# code
-- htmlCode: If it's `default`, then we will add a minimal html code. Otherwise, you need to set the relative url of the html code to load.
+- htmlCode (*optional field*): Relative url of the html code
+- cssCode (*optional field*): Relative url of the css code
 
 All the urls for `fsharpCode`, `htmlCode` are relative to the `public/samples` folder.

package.json

@@ -14,6 +14,7 @@
     "@babel/preset-react": "^7.0.0",
     "@babel/standalone": "^7.1.0",
     "@babel/template": "^7.1.0",
+    "@types/lz-string": "^1.3.32",
     "autoprefixer": "^9.1.5",
     "babel-loader": "^8.0.2",
     "bulma": "^0.7.1",

src/App/Generator.fs

@@ -84,21 +84,32 @@ let private bubbleMouseEvents =
 
 let private bundleScriptTag code = sprintf "<script type=\"module\">\n%s\n</script>\n</body>" code
 
+let private bundleLinkTag style =  sprintf """<link rel="stylesheet" type="text/css" href="%s">""" style
+
 type MimeType =
     | Html
     | JavaScript
+    | Css
 
-let generateBlobURL content mimeType =
+let generateBlobURL content mimeType : string =
     let parts = [ content ] |> unbox<ResizeArray<obj>>
     let options =
         jsOptions<BlobPropertyBag>(fun o ->
             o.``type`` <-
                 match mimeType with
                 | Html -> Some "text/html"
-                | JavaScript -> Some "text/javascript")
+                | JavaScript -> Some "text/javascript"
+                | Css -> Some "text/css")
     URL?createObjectURL(Blob.Create(parts, options))
 
-let generateHtmlBlobUrl (htmlCode : string) (jsCode: string) =
+let private addLinkTag (cssCode : string) =
+    if cssCode <> "" then
+        generateBlobURL cssCode Css
+        |> bundleLinkTag
+    else
+        ""
+
+let generateHtmlBlobUrl (htmlCode : string) (cssCode : string) (jsCode : string) =
     // We need to convert import paths to absolute urls and add .js at the end
     let reg = Regex(@"^import (.*)""(fable-core|fable-repl-lib)(.*)""(.*)$", RegexOptions.Multiline)
     let jsCode = reg.Replace(jsCode, fun m ->
@@ -113,5 +124,6 @@ let generateHtmlBlobUrl (htmlCode : string) (jsCode: string) =
         htmlCode.[..i-1]
         + bubbleMouseEvents
         + "<script type=\"module\">\n" + jsCode + "\n</script>\n"
+        + addLinkTag cssCode
         + htmlCode.[i..]
     generateBlobURL code Html

src/App/Main.fs

@@ -14,12 +14,12 @@ open Mouse
 type ISavedState =
     abstract code: string
     abstract html: string
-    abstract sample: string option
+    abstract css: string
 
 let private Worker(): Browser.Worker = importDefault "worker-loader!../Worker/Worker.fsproj"
 let private loadState(_key: string): ISavedState = importMember "./js/util.js"
-let private saveState(_key: string, _code: string, _html: string): unit = importMember "./js/util.js"
-let private updateQuery(_fsharpCode : string, _htmlCode : string): unit = importMember "./js/util.js"
+let private saveState(_key: string, _code: string, _html: string, _cssCode : string): unit = importMember "./js/util.js"
+let private updateQuery(_fsharpCode : string, _htmlCode : string, _cssCode : string): unit = importMember "./js/util.js"
 
 type IEditor = Monaco.Editor.IStandaloneCodeEditor
 
@@ -38,6 +38,7 @@ type OutputTab =
 type CodeTab =
     | FSharp
     | Html
+    | Css
 
 type DragTarget =
     | NoTarget
@@ -59,6 +60,7 @@ type Model =
       FSharpCode : string
       FSharpErrors : ResizeArray<Monaco.Editor.IMarkerData>
       HtmlCode: string
+      CssCode: string
       DragTarget : DragTarget
       PanelSplitRatio : float
       Sidebar : Sidebar.Model
@@ -96,6 +98,7 @@ type Msg =
     | SidebarMsg of Sidebar.Msg
     | ChangeFsharpCode of string
     | ChangeHtmlCode of string
+    | ChangeCssCode of string
     | UpdateQueryFailed of exn
     | RefreshIframe
 
@@ -107,8 +110,8 @@ let private addLog log (model : Model) =
                         model.Logs @ [log] }
 
 let private generateHtmlUrl (model: Model) jsCode =
-    saveState(Literals.STORAGE_KEY, model.FSharpCode, model.HtmlCode)
-    Generator.generateHtmlBlobUrl model.HtmlCode jsCode
+    saveState(Literals.STORAGE_KEY, model.FSharpCode, model.HtmlCode, model.CssCode)
+    Generator.generateHtmlBlobUrl model.HtmlCode model.CssCode jsCode
 
 let private clamp min max value =
     if value >= max
@@ -266,15 +269,16 @@ let update msg (model : Model) =
         let newModel, extraCmd =
             match externalMsg with
             | Sidebar.NoOp -> model, Cmd.none
-            | Sidebar.LoadSample (fsharpCode, htmlCode) ->
+            | Sidebar.LoadSample (fsharpCode, htmlCode, cssCode) ->
                 let cmd =
                     match model.State with
                     | Loading -> Cmd.none
                     | _ -> Cmd.ofMsg (StartCompile (Some fsharpCode)) // Trigger a new compilation
                 { model with FSharpCode = fsharpCode
-                             HtmlCode = htmlCode }, cmd
+                             HtmlCode = htmlCode
+                             CssCode = cssCode }, cmd
             | Sidebar.Share ->
-                model, Cmd.ofFunc updateQuery (model.FSharpCode, model.HtmlCode) ShareableUrlReady UpdateQueryFailed
+                model, Cmd.ofFunc updateQuery (model.FSharpCode, model.HtmlCode, model.CssCode) ShareableUrlReady UpdateQueryFailed
             | Sidebar.Reset ->
                 model, Router.newUrl Router.Reset
 
@@ -287,6 +291,9 @@ let update msg (model : Model) =
     | ChangeHtmlCode newCode ->
         { model with HtmlCode = newCode }, Cmd.none
 
+    | ChangeCssCode newCode ->
+        { model with CssCode = newCode }, Cmd.none
+
     | ShareableUrlReady () ->
         model, Toast.message "Copy it from the address bar"
                 |> Toast.title "Shareable link is ready"
@@ -307,7 +314,7 @@ let update msg (model : Model) =
 
     | RefreshIframe ->
         model
-        |> addLog ConsolePanel.Log.Separator, Cmd.performFunc (Generator.generateHtmlBlobUrl model.HtmlCode) model.CodeES2015 SetIFrameUrl
+        |> addLog ConsolePanel.Log.Separator, Cmd.performFunc (Generator.generateHtmlBlobUrl model.HtmlCode model.CssCode) model.CodeES2015 SetIFrameUrl
 
     | AddConsoleLog content ->
         model
@@ -347,7 +354,7 @@ let init () =
     let worker = ObservableWorker(Worker(), WorkerAnswer.Decoder)
 
     let saved = loadState(Literals.STORAGE_KEY)
-    let sidebarModel, sidebarCmd = Sidebar.init saved.sample
+    let sidebarModel, sidebarCmd = Sidebar.init ()
     let cmd = Cmd.batch [
                 Cmd.ups MouseUp
                 Cmd.move MouseMove
@@ -370,6 +377,7 @@ let init () =
       FSharpCode = saved.code
       FSharpErrors = ResizeArray [||]
       HtmlCode = saved.html
+      CssCode = saved.css
       DragTarget = NoTarget
       PanelSplitRatio = 0.5
       Sidebar = sidebarModel
@@ -402,6 +410,19 @@ let private htmlEditorOptions (fontSize : float) (fontFamily : string) =
         o.fontLigatures <- Some (fontFamily = "Fira Code")
     )
 
+let private cssEditorOptions (fontSize : float) (fontFamily : string) =
+    jsOptions<Monaco.Editor.IEditorConstructionOptions>(fun o ->
+        let minimapOptions =  jsOptions<Monaco.Editor.IEditorMinimapOptions>(fun oMinimap ->
+            oMinimap.enabled <- Some false
+        )
+        o.language <- Some "css"
+        o.fontSize <- Some fontSize
+        o.theme <- Some "vs-dark"
+        o.minimap <- Some minimapOptions
+        o.fontFamily <- Some fontFamily
+        o.fontLigatures <- Some (fontFamily = "Fira Code")
+    )
+
 let private fsharpEditorOptions (fontSize : float) (fontFamily : string) =
     jsOptions<Monaco.Editor.IEditorConstructionOptions>(fun o ->
         let minimapOptions = jsOptions<Monaco.Editor.IEditorMinimapOptions>(fun oMinimap ->
@@ -428,7 +449,12 @@ let private editorTabs (activeTab : CodeTab) dispatch =
                      Tabs.Tab.Props [
                          OnClick (fun _ -> SetCodeTab CodeTab.Html |> dispatch)
                      ] ]
-            [ a [ ] [ str "Html" ] ] ]
+            [ a [ ] [ str "Html" ] ]
+          Tabs.tab [ Tabs.Tab.IsActive (activeTab = CodeTab.Css)
+                     Tabs.Tab.Props [
+                         OnClick (fun _ -> SetCodeTab CodeTab.Css |> dispatch)
+                     ] ]
+            [ a [ ] [ str "Css" ] ] ]
 
 let private problemsPanel (isExpanded : bool) (errors : ResizeArray<Monaco.Editor.IMarkerData>) (currentTab : CodeTab) dispatch =
     let bodyDisplay =
@@ -481,7 +507,7 @@ let private problemsPanel (isExpanded : bool) (errors : ResizeArray<Monaco.Edito
                     yield div [ Class ("scrollable-panel-body-row " + colorClass)
                                 Data("tooltip-content", error.message)
                                 OnClick (fun _ ->
-                                    if currentTab = CodeTab.Html then
+                                    if currentTab <> CodeTab.FSharp then
                                         SetCodeTab CodeTab.FSharp |> dispatch
                                     ReactEditor.Dispatch.cursorMove "fsharp_cursor_jump" error
                                 ) ]
@@ -508,15 +534,23 @@ let private editorArea model dispatch =
                                                         model.Sidebar.Options.FontSize
                                                         model.Sidebar.Options.FontFamily)
                                ReactEditor.Value model.HtmlCode
-                               ReactEditor.IsHidden (model.CodeTab = CodeTab.FSharp)
+                               ReactEditor.IsHidden (model.CodeTab <> CodeTab.Html)
                                ReactEditor.CustomClass (fontSizeClass model.Sidebar.Options.FontSize)
                                ReactEditor.OnChange (ChangeHtmlCode >> dispatch) ]
+          // Css editor
+          ReactEditor.editor [ ReactEditor.Options (cssEditorOptions
+                                                        model.Sidebar.Options.FontSize
+                                                        model.Sidebar.Options.FontFamily)
+                               ReactEditor.Value model.CssCode
+                               ReactEditor.IsHidden (model.CodeTab <> CodeTab.Css)
+                               ReactEditor.CustomClass (fontSizeClass model.Sidebar.Options.FontSize)
+                               ReactEditor.OnChange (ChangeCssCode >> dispatch) ]
           // F# editor
           ReactEditor.editor [ ReactEditor.Options (fsharpEditorOptions
                                                         model.Sidebar.Options.FontSize
                                                         model.Sidebar.Options.FontFamily)
                                ReactEditor.Value model.FSharpCode
-                               ReactEditor.IsHidden (model.CodeTab = CodeTab.Html)
+                               ReactEditor.IsHidden (model.CodeTab <> CodeTab.FSharp)
                                ReactEditor.OnChange (ChangeFsharpCode >> dispatch)
                                ReactEditor.Errors model.FSharpErrors
                                ReactEditor.EventId "fsharp_cursor_jump"

src/App/Sidebar.fs

@@ -19,7 +19,7 @@ type Msg =
     | UpdateStats of Widgets.Stats.Model
 
 type ExternalMsg =
-    | LoadSample of string * string
+    | LoadSample of fsharp : string * html : string * css : string
     | NoOp
     | Reset
     | Share
@@ -45,7 +45,7 @@ let update msg model =
         let extraMsg =
             match externalMsg with
             | Widgets.Samples.NoOp -> NoOp
-            | Widgets.Samples.LoadSample (fsharpCode, htmlCode) -> LoadSample (fsharpCode, htmlCode)
+            | Widgets.Samples.LoadSample (fsharpCode, htmlCode, cssCode) -> LoadSample (fsharpCode, htmlCode, cssCode)
 
         { model with Samples = samplesModel }, Cmd.map SamplesMsg samplesCmd, extraMsg