WIP sample viewer and references

fable_elmish_github_io.fsproj

@@ -20,6 +20,7 @@
     <Compile Include="src/Doc/Viewer/View.fs" />
     <!-- Sample -->
     <Compile Include="src/Sample/Index/Types.fs" />
+    <Compile Include="src/Sample/Index/State.fs" />
     <Compile Include="src/Sample/Index/View.fs" />
     <Compile Include="src/Sample/Viewer/Types.fs" />
     <Compile Include="src/Sample/Viewer/State.fs" />

src/App.fs

@@ -47,7 +47,7 @@ let root model dispatch =
         Doc.Viewer.View.root model.docViewer // TODO: use name
     | Docs _ ->
         Doc.Index.View.root
-    | Samples (Some (height,url)) ->
+    | Samples (Some sampleKey) ->
         Sample.Viewer.View.root model.sampleViewer // TODO: use height
     | Samples _ ->
         Sample.Index.View.root
@@ -76,7 +76,7 @@ open Elmish.Debug
 Program.mkProgram init update root
 |> Program.toNavigable (parseHash pageParser) urlUpdate
 |> Program.withReact "elmish-app"
-#if DEBUG
-|> Program.withDebugger
-#endif
+// #if DEBUG
+// |> Program.withDebugger
+// #endif
 |> Program.run

src/Global.fs

@@ -7,7 +7,7 @@ type Page =
   | Home
   | About
   | Docs of string option
-  | Samples of (int * string) option
+  | Samples of string option
 
 let toHash page =
   match page with
@@ -17,8 +17,8 @@ let toHash page =
       sprintf "#docs/%s" name
   | Docs _ ->
       "#docs"
-  | Samples (Some (height,url)) ->
-       sprintf "#samples/%i/%s" height url
+  | Samples (Some sampleKey) ->
+       sprintf "#samples/%s" sampleKey
   | Samples _ ->
       "#samples"
 

src/Sample/Index/State.fs

@@ -0,0 +1,31 @@
+module Sample.Index.State
+
+open Types
+open Fable.Core
+
+let sampleReferences =
+  Map.empty<string, SampleReference>
+    .Add(
+      "sample-react-calc",
+      { demoUrl = "https://fable-elmish.github.io/sample-react-calc/"
+        sourceUrl = "https://github.com/fable-elmish/sample-react-counter"
+        height = 300 }
+    )
+    .Add(
+      "sample-react-calc2",
+      { demoUrl = ""
+        sourceUrl = ""
+        height = 300 }
+    )
+    .Add(
+      "sample-react-calc2",
+      { demoUrl = ""
+        sourceUrl = ""
+        height = 300 }
+    )
+    .Add(
+      "sample-react-calc2",
+      { demoUrl = ""
+        sourceUrl = ""
+        height = 300 }
+    )

src/Sample/Index/Types.fs

@@ -2,18 +2,15 @@ module Sample.Index.Types
 
 open Global
 
-type SampleUrl =
-  { url: string
-    height: int }
-
-let defaultSampleUrl =
-  { url = ""
-    height = 300 }
-
 type SampleInfo =
   { title: string
     description: string
-    url: SampleUrl }
+    sampleKey: string }
+
+type SampleReference =
+  { demoUrl: string
+    sourceUrl: string
+    height: int }
 
 type Sample =
   | Tile of SampleInfo

src/Sample/Index/View.fs

@@ -16,7 +16,7 @@ let tileDocs tile =
             [ p
                 [ ClassName "title" ]
                 [ a
-                    [ Href (toHash (Samples (Some (info.url.height, info.url.url)))) ]
+                    [ Href (toHash ((info.sampleKey) |> (Some >> Samples))) ]
                     [ str info.title ] ]
               p
                 [ ClassName "subtitle" ]
@@ -75,13 +75,13 @@ let root =
           [
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
           ]
       }
       hr []
@@ -91,13 +91,13 @@ let root =
           [
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
           ]
       }
       hr []
@@ -107,12 +107,12 @@ let root =
           [
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
             { title = "Title"
               description = "Description"
-              url = defaultSampleUrl }
+              sampleKey = "sample-react-calc" }
           ]
       } ]

src/Sample/Viewer/State.fs

@@ -11,5 +11,30 @@ let init () =
   { currentFile = ""
     samplesHTML = [] }, []
 
+let createEmptySampleHtml sampleKey =
+  { sampleKey = sampleKey
+    html = ""
+    state = Available }
+
+let fetchMarkdown fileName =
+  promise {
+    let! res = fetch (createDocFilesDirectoryURL fileName) []
+    let! txt = res.text()
+    return Marked.Globals.marked.parse txt
+  }
+
 let update msg model =
-  model, []
+  match msg with
+  | SetSample sampleKey ->
+      // Fetch the markdown content only if unkown doc entry
+      let exist =
+        model.samplesHTML
+        |> List.exists(fun x -> x.sampleKey = sampleKey )
+
+      if exist then
+        { model with currentFile = sampleKey }, []
+      else
+        { model with
+            currentFile = sampleKey
+            samplesHTML = (createEmptySampleHtml sampleKey) :: model.samplesHTML }
+        , []//Cmd.ofPromise fetchMarkdown fileName (fun x -> SetDocHtml (fileName, x)) (fun x -> Error (fileName, string x))

src/Sample/Viewer/Types.fs

@@ -8,7 +8,7 @@ type State =
   | Error
 
 type SampleHTML =
-  { url: string
+  { sampleKey: string
     html: string
     state: State }
 

src/Sample/Viewer/View.fs

@@ -7,13 +7,13 @@ open Global
 open Types
 
 let root model =
-  let doc =
+  let sample =
     // Catch KeyNotFoundException which occured when the markdown
     // content have never been fetched yet
     try
       model.samplesHTML
       |> List.find(fun x ->
-        x.url = model.currentFile
+        x.sampleKey = model.currentFile
       )
       |> Some
     with _ -> None
@@ -27,14 +27,14 @@ let root model =
       ]
 
   let html =
-    match doc with
+    match sample with
     | None -> loader
-    | Some doc ->
-        match doc.state with
+    | Some sample ->
+        match sample.state with
         | Available ->
             div
               [ DangerouslySetInnerHTML {
-                  __html = Marked.Globals.marked.parse(doc.html)
+                  __html = Marked.Globals.marked.parse(sample.html)
                 } ]
               [ ]
         | Pending -> loader
@@ -50,6 +50,49 @@ let root model =
                       [ Href "https://github.com/fable-elmish/fable-elmish.github.io" ]
                       [ str "open an issue." ] ] ]
 
+  // div
+  //   [ ClassName "content" ]
+  //   [ html ]
   div
     [ ClassName "content" ]
-    [ html ]
+    [ div
+        [ ClassName "container" ]
+        [ h1
+            [ ClassName "has-text-centered" ]
+            [ str "Demo" ]
+          div
+            [ ClassName "columns" ]
+            [ div
+                [ ClassName "column is-half is-offset-one-quarter has-text-centered" ]
+                [ a
+                    [ ClassName "button is-primary is-pulled-left"
+                      Href sample.Value.sampleKey
+                      Target "_blank" ]
+                    [ str "Open in tab" ]
+                  a
+                    [ ClassName "button is-pulled-right"
+                      Href ""//(DocGen.githubURL model.CurrentFile)
+                      Target "_blank" ]
+                    [ span
+                        [ ClassName "icon"]
+                        [ i
+                            [ ClassName "fa fa-github" ]
+                            [ ] ]
+                      span
+                        []
+                        [ str "Go to source" ] ]
+                  br []
+                  br []
+                  iframe
+                    [ ClassName "sample-viewer"
+                      Src sample.Value.sampleKey
+                      Style [ Height 300 ] ]
+                    [] ] ]
+          div
+            [ ClassName "content" ]
+            [ h1
+                [ ClassName "has-text-centered" ]
+                [ str "Explanations" ]
+              div
+                [ ClassName "container" ]
+                [ html ] ] ] ]

src/State.fs

@@ -9,13 +9,12 @@ open Types
 
 
 let pageParser: Parser<Page->Page,_> =
-  let curry f = fun a b -> f (a,b)
   oneOf [
     map About (s "about")
     map Home (s "home")
     map (Some >> Docs) (s "docs" </> str)
     map (Docs None) (s "docs")
-    map (curry (Some >> Samples)) (s "samples" </> i32 </> str)
+    map (Some >> Samples) (s "samples" </> str)
     map (Samples None) (s "samples")
     map Home top
   ]
@@ -26,13 +25,14 @@ let urlUpdate (result: Option<Page>) model =
     console.error("Error parsing url")
     model,Navigation.modifyUrl (toHash model.currentPage)
   | Some page ->
-      Fable.Import.Browser.console.log page
       let msg =
         match page with
         | Docs (Some page) ->
             Cmd.ofMsg (DocViewerMsg (Doc.Viewer.Types.SetDoc page))
         | Docs _ ->
             []
+        | Samples (Some infos) ->
+            Cmd.ofMsg (SampleViewerMsg (Sample.Viewer.Types.SetSample infos))
         | _ -> []
       { model with currentPage = page }, msg