gistfile1.hs

{-# LANGUAGE RecursiveDo #-}
import Reflex
import Reflex.Dom
import qualified Data.Map as Map
import Safe (readMay)
import Control.Applicative ((<*>), (<$>))

main = mainWidget $ el "div" $ do
  nx <- numberInput
  d <- dropdown "*" (constDyn ops) def
  ny <- numberInput
  values <- combineDyn (,) nx ny
  result <- combineDyn (\o (x,y) -> stringToOp o <$> x <*> y) (_dropdown_value d) values
  resultString <- mapDyn show result
  text " = "
  dynText resultString

numberInput :: (MonadWidget t m) => m (Dynamic t (Maybe Double))
numberInput = do
  let errorState = Map.singleton "style" "border: 3px solid red"
      validState = Map.singleton "style" "border: 3px solid green"
  rec n <- elDynAttr "span" attrs $ do
        textInput $ def & textInputConfig_inputType .~ "number"
                        & textInputConfig_initialValue .~ "0"
      result <- mapDyn readMay $ _textInput_value n
      attrs <- mapDyn (\r -> case r of
                                  Just _ -> validState
                                  Nothing -> errorState) result
  return result

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

ops = Map.fromList [("+", "+"), ("-", "-"), ("*", "*"), ("/", "/")]