module Form.Input ( inputText, inputNumber, inputUnion, TypeName (..), Type (..), typeName, stringToTypeName, ) where import Control.Applicative import Control.Arrow (first, second) import Data.Aeson qualified as A import Data.Map qualified as M import Data.Maybe (fromMaybe) import Form.Internal import GHC.Generics (Generic) import Miso import Miso.String (MisoString, fromMisoString, null, strip, toMisoString) data TypeName = StringType | NumberType deriving (Eq, Ord, Generic) instance IsEmpty (TypeName, M.Map TypeName MisoString) where isEmpty (k, kvs) = isEmpty (fromMaybe "" (M.lookup k kvs)) instance A.FromJSON TypeName instance A.ToJSON TypeName instance A.FromJSONKey TypeName instance A.ToJSONKey TypeName data Type = IsNumber Double | IsString MisoString instance A.ToJSON Type where toJSON (IsNumber x) = A.Number (realToFrac x) toJSON (IsString x) = A.String x instance A.FromJSON Type where parseJSON = \case A.Number x -> pure (IsNumber (realToFrac x)) A.String x -> pure (IsString x) _ -> fail "" typeName :: Type -> TypeName typeName (IsNumber _) = NumberType typeName (IsString _) = StringType stringToTypeName :: MisoString -> TypeName stringToTypeName "number" = NumberType stringToTypeName "string" = StringType stringToTypeName _ = StringType 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 }