Form validation with Reflex FRP in haskell

Calc.hs

{- Based on https://github.com/ryantrinkle/try-reflex/README.md .
   This is the try Reflex calculator example modified
   to collect the two numbers and an operator into a Maybe Calculation.
   So we use the validation for each field to validate the form as a hole.
   This could be useful to build forms for e.g. an admin interface. -}

{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GADTs #-}

import Reflex
import Reflex.Dom
import Reflex.Dynamic.TH -- to build records with qDyn and unqDyn
import qualified Data.Map as Map
import Safe (readMay)
import Control.Applicative ((<$>),(<*>))

--- Model

data Calculation = Calculation { lhs :: Double, rhs :: Double, op :: String } deriving (Show, Eq)

-- Conversion

stringToOp s = case s of
  "-" -> (-)
  "*" -> (*)
  "/" -> (/)
  _   -> (+)

-- Form validation

createCalculation :: Maybe Double -> Maybe Double -> String -> Maybe Calculation
createCalculation x y op = Calculation <$> x <*> y <*> (Just op)

--- Widgets

ops :: Map.Map String String
ops = Map.fromList [("+","+"), ("-","-"), ("*","*"), ("/", "/")]
main = mainWidget $ el "div" $ do
  calculator

calculator = el "div" $ do
  nx <- numberInput
  d <- dropdown "*" $ constDyn ops
  ny <- numberInput
  text " Record "



-- Form validation

createCalculation :: Maybe Double -> Maybe Double -> String -> Maybe Calculation
createCalculation x y op = Calculation <$> x <*> y <*> (Just op)

--- Widgets

ops :: Map.Map String String
ops = Map.fromList [("+","+"), ("-","-"), ("*","*"), ("/", "/")]
main = mainWidget $ el "div" $ do
  calculator

calculator = el "div" $ do
  nx <- numberInput
  d <- dropdown "*" $ constDyn ops
  ny <- numberInput
  text " Record "
  -- Template haskell more efficient than list of cascading events. 
  -- it could also work to make combineDyn3, combineDyn4 etc.
  -- The combineDyn cascade below works, but is not efficient and gets very tedious with bigger records
  -- result2 <- combineDyn (\x y -> Calculation x y) nx ny
  -- resultRecord <- combineDyn (\o r -> r o ) (_dropdown_value d) result2
  -- so we replace it with template haskell:
  resultTH <- $(qDyn [| createCalculation
                          $(unqDyn [| nx |])
                          $(unqDyn [| ny |])
                          $(unqDyn [| (_dropdown_value d) |]) |])

  display resultTH
  text " Result: "
  result <- mapDyn (fmap (\(Calculation l r op) -> (stringToOp op) l r)) resultTH
  display result

numberInput :: MonadWidget t m => m (Dynamic t (Maybe Double))
numberInput = do
  let errorState = Map.singleton "style" "border-color: red"
      validState = Map.singleton "style" "border-color: green"
  rec n <- input' "number" "0" never attrs
      result <- mapDyn readMay $ _textInput_value n
      attrs <- mapDyn (\r -> case r of
                                  Just _ -> validState
                                  Nothing -> errorState) result
  return result

Thanks to saulzar_ on irc, rewrite the result calculation as:

result <- mapDyn (fmap ((Calculation l r op) -> (stringToOp op) l r)) resultTH