Add possibility for CSS and JS in forms (#10)

.github/actions/spelling/line_forbidden.patterns

@@ -12,9 +12,6 @@
 # s.b. GitLab
 \bGitlab\b
 
-# s.b. JavaScript
-\bJavascript\b
-
 # s.b. Microsoft
 \bMicroSoft\b
 

flex-task/src/FlexTask/FormUtil.hs

@@ -1,11 +1,15 @@
 {-# language OverloadedStrings #-}
 {-# language QuasiQuotes #-}
+{-# language TypeOperators #-}
 
 {- | Functions for creating and composing forms.
 -}
 
 module FlexTask.FormUtil
   ( ($$>)
+  , addCss
+  , addJs
+  , addCssAndJs
   , getFormData
   , newFlexId
   , newFlexName
@@ -15,36 +19,93 @@ module FlexTask.FormUtil
 
 import Control.Monad.Reader            (runReader)
 import Data.Text                       (Text, pack, unpack)
+import Data.Tuple.Extra                (second)
 import System.Log.FastLogger           (defaultBufSize, newStdoutLoggerSet)
 import Text.Blaze.Html.Renderer.String (renderHtml)
-import Text.Julius                     (RawJS(..))
+import Text.Cassius                    (Css)
+import Text.Julius                     (Javascript, RawJS(..))
 import Yesod
+import Yesod.Core.Types                (RY)
 import Yesod.Default.Config2           (makeYesodLogger)
 
 import qualified Control.Monad.Trans.RWS as RWS   (get)
 import qualified Data.Text               as T     (replace)
 import qualified Yesod.Core.Unsafe       as Unsafe
 
-import FlexTask.YesodConfig  (FlexForm(..), Handler, Rendered, Rendered')
+import FlexTask.YesodConfig (
+  FlexForm(..),
+  Handler,
+  Rendered,
+  Rendered',
+  Widget,
+  )
 
 
 
 
 {- |
-compose two forms sequentially.
+Compose two forms sequentially.
 The output form contains all of the fields from both input forms.
 -}
 infixr 0 $$>
 ($$>) :: Monad m => Rendered' m -> Rendered' m -> Rendered' m
-first $$> second = do
-    res1 <- first
-    res2 <- second
+f1 $$> f2 = do
+    res1 <- f1
+    res2 <- f2
     pure $ do
       (names1,wid1) <- res1
       (names2,wid2) <- res2
       pure (names1++names2, wid1 >> wid2)
 
 
+applyToWidget :: Functor m => (Widget -> Widget) -> Rendered' m -> Rendered' m
+applyToWidget f form = fmap (second f) <$> form
+
+
+addContent
+  :: (ToWidget FlexForm (render -> a), Functor m)
+  => (render -> a)
+  -> Rendered' m
+  -> Rendered' m
+addContent content = applyToWidget (<* toWidget content)
+
+
+{- |
+Add CSS to a form.
+Use with `Yesod` Cassius or Lucius Shakespeare quasi quoters or hosted files.
+-}
+addCss
+  :: (render ~ RY FlexForm, Functor m)
+  => (render -> Css) -- ^ CSS template
+  -> Rendered' m     -- ^ Form to add to
+  -> Rendered' m
+addCss = addContent
+
+
+{- |
+Add JavaScript to a form.
+Use with `Yesod` Julius Shakespeare quasi quoters or hosted files.
+-}
+addJs
+  :: (render ~ RY FlexForm, Functor m)
+  => (render -> Javascript) -- ^ Javascript template
+  -> Rendered' m            -- ^ Form to add to
+  -> Rendered' m
+addJs = addContent
+
+
+{- |
+Like `addCss` and `addJs`, but for including CSS and JavaScript in one step.
+-}
+addCssAndJs
+  :: (render ~ RY FlexForm, Functor m)
+  => (render -> Css)        -- ^ CSS template
+  -> (render -> Javascript) -- ^ Javascript template
+  -> Rendered' m            -- ^ Form to add to
+  -> Rendered' m
+addCssAndJs css js = applyToWidget ((<* toWidget css) . (<* toWidget js))
+
+
 {- |
 Get a unique identifier for an html element.
 The format is "flexident[number]"
@@ -123,5 +184,7 @@ getFormData widget = do
       ((names,wid),_) <- runFormGet $ runReader widget
       let withJS = wid >> toWidgetBody (setDefaultsJS names)
       content <- widgetToPageContent withJS
-      html <- withUrlRenderer [hamlet|^{pageBody content}|]
+      html <- withUrlRenderer [hamlet|
+        ^{pageHead content}
+        ^{pageBody content}|]
       return (names,html)