module Form.Input ( inputText, inputNumber, inputUnion, TypeName(..), Type(..) ) where import Control.Applicative import Control.Arrow (first, second) import Data.Map qualified as M import Form.Internal import Miso import Miso.String (MisoString, fromMisoString, null, strip, toMisoString) data TypeName = StringType | NumberType deriving (Eq, Ord) data Type = IsNumber Double | IsString MisoString inputUnion :: MisoString -> [TypeName] -> Form (TypeName, M.Map TypeName MisoString) (Maybe Type) inputUnion label types = foldl1 (<|>) <$> mapM ( \case StringType -> mapValues ( \(selectedType, typeInputs) -> ( selectedType == StringType, M.findWithDefault "" StringType typeInputs ) ) ( \(checked, inputString) (selectedType, typeInputs) -> ( if checked then StringType else selectedType, M.insert StringType inputString typeInputs ) ) $ fmap (fmap IsString) $ withRadio $ inputText label NumberType -> mapValues ( \(selectedType, typeInputs) -> ( selectedType == NumberType, M.findWithDefault "" NumberType typeInputs ) ) ( \(checked, inputString) (selectedType, typeInputs) -> ( if checked then NumberType else selectedType, M.insert NumberType inputString typeInputs ) ) $ fmap (fmap IsNumber) $ withRadio $ inputNumber label ) types radio :: Form Bool Bool radio = Form { view = \checked -> [ div_ [] $ [ input_ [ type_ "radio", checked_ checked, onClick (not checked) ] ] ], fill = Right } withRadio :: Form i o -> Form (Bool, i) (Maybe o) withRadio form = (\(checked, x) -> if checked then Just x else Nothing) <$> liftA2 (,) (mapValues fst (first . const) radio) (mapValues snd (second . const) form) inputNumber :: MisoString -> Form MisoString Double inputNumber label = let parse :: MisoString -> Either MisoString Double parse i = let i' = strip i in if Miso.String.null i' then Left "required" else Right (read (fromMisoString i')) in Form { view = \i -> [ div_ [] $ [ label_ [] $ [ text label, div_ [] $ [ input_ [ type_ "number", value_ (toMisoString (show i)), onInput id ], div_ [] $ [either text (\_ -> text "") (parse i)] ] ] ] ], fill = parse } inputText :: MisoString -> Form MisoString MisoString inputText label = let parse :: MisoString -> Either MisoString MisoString parse i = let i' = strip i in if Miso.String.null i' then Left "required" else Right i' in Form { view = \i -> [ div_ [] $ [ label_ [] $ [ text label, div_ [] $ [ input_ [ type_ "text", value_ i, onInput id ], div_ [] $ [either text (\_ -> text "") (parse i)] ] ] ] ], fill = parse }