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 (fromMisoString x)

instance A.FromJSON Type where
  parseJSON = \case
    A.Number x -> pure (IsNumber (realToFrac x))
    A.String x -> pure (IsString (toMisoString 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_ [class_ "input text"] $
                [ label_ [] $
                    [ text label,
                      div_ [] $
                        [ input_
                            [ type_ "text",
                              value_ i,
                              onInput id
                            ],
                          div_ [class_ "error-helper"] $
                            [either text (\_ -> text "") (parse i)]
                        ]
                    ]
                ]
            ],
          fill = parse
        }