Try to make interactive snippets form

src/Guide/Handlers.hs

@@ -45,6 +45,8 @@ import Guide.Types
 import Guide.Utils
 import Guide.Views
 
+import Snippets.Renderer (renderSnippets)
+
 methods :: GuideM ctx ()
 methods = do
   renderMethods
@@ -408,6 +410,10 @@ adminMethods = Spock.subcomponent "admin" $ do
   Spock.post "create-checkpoint" $ do
     db <- _db <$> Spock.getState
     createCheckpoint' db
+  -- Snippets
+  Spock.post ("set/snippets") $ do
+        content' <- param' "content"
+        lucidIO $ renderSnippets content'
 
 ----------------------------------------------------------------------------
 -- Utils

src/Guide/JS.hs

@@ -58,7 +58,8 @@ allJSFunctions = JS . T.unlines . map fromJS $ [
   -- Admin things
   acceptEdit, undoEdit,
   acceptBlock, undoBlock,
-  createCheckpoint ]
+  createCheckpoint,
+  submitMarkdownSnippet]
 
 -- | A class for things that can be converted to Javascript syntax.
 class ToJS a where toJS :: a -> JS
@@ -727,3 +728,16 @@ selectChildren a b = JQuerySelector $ format "{} > {}" a b
 selectSection :: JQuerySelector -> Text -> JQuerySelector
 selectSection a b = JQuerySelector $ format "{} > .section.{}" a b
 
+submitMarkdownSnippet :: JSFunction a => a
+submitMarkdownSnippet =
+  makeJSFunction "submitMarkdownSnippet"
+                 ["ours"]
+  [text|
+    $.post({
+      url: "/admin/snippets/set/snippets",
+      data: {
+        content: ours },
+      success: function (data) {
+        $(document).replaceWith(data); },
+      });
+  |]

src/Guide/Main.hs

@@ -68,7 +68,7 @@ import Guide.JS (JS(..), allJSFunctions)
 import Guide.Utils
 import Guide.Cache
 import Guide.Session
-import Snippets.Renderer (renderTestSnippets)
+import Snippets.Renderer (renderSnippets)
 
 {- Note [acid-state]
 ~~~~~~~~~~~~~~~~~~~~
@@ -261,7 +261,7 @@ guideApp waiMetrics = do
           s <- dbQuery GetGlobalState
           lucidIO $ renderAdminLinks s
         Spock.get ("admin" <//> "snippets") $
-          lucidIO renderTestSnippets
+          lucidIO $ renderSnippets ""
 
       -- Donation page
       Spock.get "donate" $

src/Snippets/Parser.hs

@@ -4,6 +4,7 @@
 -}
 module Snippets.Parser
 ( mainParse
+, parseCustomText
 , Snippet
 , SnippetLine
 , SnippetNode(..)
@@ -212,3 +213,12 @@ mainParse = do
     case nodes of
           Left err -> pure [CodeText (T.pack $ show err)]
           Right p  -> pure p
+
+parseCustomText :: Text -> Snippet
+parseCustomText txt =
+  let progLines = T.lines txt in
+  for progLines $ \line ->
+    let nodes = MP.parse parseLine "" line in
+    case nodes of
+      Left err -> [CodeText (T.pack $ show err)]
+      Right p  -> p

src/Snippets/Renderer.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 {-|
   Code Snippets renderer to Html
@@ -16,23 +17,48 @@ import           Lucid                           hiding (for_)
 import           Text.Blaze.Html.Renderer.String (renderHtml)
 import           Text.Highlighting.Kate
 
+import qualified Guide.JS as JS
 import           Guide.Utils
+import           Guide.Views.Utils
 import           Snippets.Parser
 
 {-|
 Renders given text example to Lucid
 -}
-renderTestSnippets :: (MonadIO m) => HtmlT m ()
-renderTestSnippets = do
-  nodes <- liftIO mainParse
+renderSnippets :: (MonadIO m) => Text -> HtmlT m ()
+renderSnippets t =
   head_ $ do
     includeCSS "/snippets.css"
     includeCSS "/highlight.css"
+    includeJS "/jquery.js"
     title_ "Snippets – Aelve Guide"
     meta_ [ name_ "viewport"
           , content_ "width=device-width, initial-scale=1.0, user-scalable=yes"
           ]
-    body_ $ renderSnippet nodes
+    body_ $ do
+      let formSubmitHandler formNode = JS.submitMarkdownSnippet (JS.selectId "result", formNode)
+      form_ [method_ "POST", id_ "snippetForm", onFormSubmit formSubmitHandler] $
+        fieldset_ $ do
+          legend_ "Snippets Parser"
+          label_ $
+            "Snippet" >> br_ []
+          -- looks like using Guide.Views.Utils.Input
+          textarea_ [ id_ "snippet", name_ "snippet"
+                 , form_ "snippetForm"
+                 , rows_ "10"
+                 , cols_ "75"
+                 ] $ toHtml t
+          br_ []
+          input_ [type_ "submit", value_ "Parse", class_ "save"]
+          input_ [type_ "reset"]
+      div_ [id_ "result"] $
+        renderSnippet $ parseCustomText t
+
+
+--renderTestSnippets :: (MonadIO m) => HtmlT m ()
+--renderTestSnippets = do
+--  sn <- liftIO mainParse
+--  renderSnippets sn
 
 -- Doesn't create tab if no multiple snippets
 -- In this case 'renderTab' works with fake "singleSnippet" label