Merge pull request #80 from garyb/field-labels-in-eval

Include form field labels in `eval`

Author: garyb

src/Text/Markdown/SlamDown/Eval.purs

@@ -27,9 +27,9 @@ eval
   . Monad m
   ⇒ SD.Value a
   ⇒ { code ∷ M.Maybe LanguageId → String → m a
-    , textBox ∷ SD.TextBox (Const String) → m (SD.TextBox Identity)
-    , value ∷ String → m a
-    , list ∷ String → m (L.List a)
+    , textBox ∷ String → SD.TextBox (Const String) → m (SD.TextBox Identity)
+    , value ∷ String → String → m a
+    , list ∷ String → String → m (L.List a)
     }
   → SD.SlamDownP a
   → m (SD.SlamDownP a)
@@ -44,48 +44,48 @@ eval fs = everywhereM b i
 
   i ∷ SD.Inline a → m (SD.Inline a)
   i (SD.Code true code) = SD.Code false <<< SD.renderValue <$> fs.code M.Nothing code
-  i (SD.FormField l r field) = SD.FormField l r <$> f field
+  i (SD.FormField lbl r field) = SD.FormField lbl r <$> f lbl field
   i other = pure $ other
 
-  f ∷ SD.FormField a → m (SD.FormField a)
-  f (SD.TextBox tb) = SD.TextBox <<< M.fromMaybe tb <$> nbeTextBox tb
+  f ∷ String → SD.FormField a → m (SD.FormField a)
+  f lbl (SD.TextBox tb) = SD.TextBox <<< M.fromMaybe tb <$> nbeTextBox tb
     where
       -- normalization-by-evaluation proceeds by evaluating an object into a semantic model
       -- (in this case, `Identity`), and then quoting the result back into the syntax.
       nbeTextBox ∷ SD.TextBox (Compose M.Maybe SD.Expr) → m (M.Maybe (SD.TextBox (Compose M.Maybe SD.Expr)))
       nbeTextBox = evalTextBox >>> map (map quoteTextBox)
 
       evalTextBox ∷ SD.TextBox (Compose M.Maybe SD.Expr) → m (M.Maybe (SD.TextBox Identity))
-      evalTextBox tb' = T.sequence $ fs.textBox <$> asCode tb' <|> pure <$> asLit tb'
+      evalTextBox tb' = T.sequence $ fs.textBox lbl <$> asCode tb' <|> pure <$> asLit tb'
         where
           asLit = SD.traverseTextBox (unwrap >>> (_ >>= SD.getLiteral) >>> map Identity)
           asCode = SD.traverseTextBox (unwrap >>> (_ >>= SD.getUnevaluated) >>> map Const)
 
       quoteTextBox ∷ SD.TextBox Identity → SD.TextBox (Compose M.Maybe SD.Expr)
       quoteTextBox = SD.transTextBox (unwrap >>> SD.Literal >>> M.Just >>> Compose)
 
-  f (SD.RadioButtons sel opts) = do
-    sel' ← evalExpr fs.value sel
-    opts' ← evalExpr fs.list opts
+  f lbl (SD.RadioButtons sel opts) = do
+    sel' ← evalExpr lbl fs.value sel
+    opts' ← evalExpr lbl fs.list opts
     pure $ SD.RadioButtons sel' (mergeSelection (L.singleton <$> sel') opts')
 
-  f (SD.CheckBoxes sel vals) = do
-    sel' ← evalExpr fs.list sel
-    vals' ← evalExpr fs.list vals
+  f lbl (SD.CheckBoxes sel vals) = do
+    sel' ← evalExpr lbl fs.list sel
+    vals' ← evalExpr lbl fs.list vals
     pure $ SD.CheckBoxes sel' (mergeSelection sel' vals')
 
-  f (SD.DropDown msel opts) = do
-    msel' ← T.traverse (evalExpr fs.value) msel
-    opts' ← evalExpr fs.list opts
+  f lbl (SD.DropDown msel opts) = do
+    msel' ← T.traverse (evalExpr lbl fs.value) msel
+    opts' ← evalExpr lbl fs.list opts
     pure $ SD.DropDown msel' $ M.maybe opts' (flip mergeSelection opts' <<< map L.singleton) msel'
 
   mergeSelection ∷ SD.Expr (L.List a) → SD.Expr (L.List a) → SD.Expr (L.List a)
   mergeSelection (SD.Literal sel) (SD.Literal xs) = SD.Literal $ L.union sel xs
   mergeSelection _ exs = exs
 
-  evalExpr ∷ ∀ e. (String → m e) → SD.Expr e → m (SD.Expr e)
-  evalExpr _ (SD.Literal a) = pure $ SD.Literal a
-  evalExpr e (SD.Unevaluated s) = SD.Literal <$> e s
+  evalExpr ∷ ∀ e. String → (String → String → m e) → SD.Expr e → m (SD.Expr e)
+  evalExpr _ _ (SD.Literal a) = pure $ SD.Literal a
+  evalExpr l e (SD.Unevaluated s) = SD.Literal <$> e l s
 
   getValues ∷ ∀ e. SD.Expr (L.List e) → L.List e
   getValues (SD.Literal vs) = vs

test/src/Test/Main.purs

@@ -238,7 +238,7 @@ static = do
           $ un ID.Identity
           $ SDE.eval
             { code: \_ _ → pure $ SD.stringValue "Evaluated code block!"
-            , textBox: \t →
+            , textBox: \_ t →
                 case t of
                   SD.PlainText _ → pure $ SD.PlainText $ pure "Evaluated plain text!"
                   SD.Numeric _ → pure $ SD.Numeric $ pure $ HN.fromNumber 42.0
@@ -251,8 +251,8 @@ static = do
                   SD.DateTime (prec@SD.Seconds) _ →
                     pure $ SD.DateTime prec $ pure $
                       DT.DateTime (unsafeDate 1992 7 30) (unsafeTime 4 52 10)
-            , value: \_ → pure $ SD.stringValue "Evaluated value!"
-            , list: \_ → pure $ L.singleton $ SD.stringValue "Evaluated list!"
+            , value: \_ _ → pure $ SD.stringValue "Evaluated value!"
+            , list: \_ _ → pure $ L.singleton $ SD.stringValue "Evaluated list!"
             }  sd
       a → a