{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# OPTIONS_GHC -Wall #-}

-- | Common web page input elements, often with bootstrap scaffolding.
module Web.Page.Html.Input
  ( Input (..),
    InputType (..),
  )
where

import Data.Bool
import Data.Maybe
import Data.Text
import GHC.Generics
import Lucid
import Lucid.Base
import Web.Page.Html
import Prelude

-- | something that might exist on a web page and be a front-end input to computations.
data Input a
  = Input
      { -- | underlying value
        inputVal :: a,
        -- | label suggestion
        inputLabel :: Maybe Text,
        -- | name//key//id of the Input
        inputId :: Text,
        -- | type of html input
        inputType :: InputType
      }
  deriving (Eq, Show, Generic)

-- | Various types of web page inputs, encapsulating practical bootstrap class functionality
data InputType
  = Slider [Attribute]
  | TextBox
  | TextArea Int
  | ColorPicker
  | ChooseFile
  | Dropdown [Text]
  | DropdownSum [Text]
  | Datalist [Text] Text
  | Checkbox Bool
  | Toggle Bool (Maybe Text)
  | Button
  deriving (Eq, Show, Generic)

instance (ToHtml a) => ToHtml (Input a) where

  toHtml (Input v l i (Slider satts)) =
    with
      div_
      [class__ "form-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> input_
            ( [ type_ "range",
                class__ " form-control-range custom-range jsbClassEventChange",
                id_ i,
                value_ (pack $ show $ toHtml v)
              ]
                <> satts
            )
      )
  toHtml (Input v l i TextBox) =
    with
      div_
      [class__ "form-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> input_
            ( [ type_ "text",
                class__ "form-control jsbClassEventInput",
                id_ i,
                value_ (pack $ show $ toHtmlRaw v)
              ]
            )
      )
  toHtml (Input v l i (TextArea rows)) =
    with
      div_
      [class__ "form-group"]
      ( maybe mempty (with label_ [for_ i] . toHtml) l
          <> ( with
                 textarea_
                 [ rows_ (pack $ show rows),
                   class__ "form-control jsbClassEventInput",
                   id_ i
                 ]
                 (toHtmlRaw v)
             )
      )
  toHtml (Input v l i ColorPicker) =
    with
      div_
      [class__ "form-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> input_
            ( [ type_ "color",
                class__ "form-control jsbClassEventInput",
                id_ i,
                value_ (pack $ show $ toHtml v)
              ]
            )
      )
  toHtml (Input _ l i ChooseFile) =
    with
      div_
      [class__ "form-group"]
      (maybe mempty (with label_ [for_ i] . toHtml) l)
      <> input_
        ( [ type_ "file",
            class__ "form-control-file jsbClassEventChooseFile",
            id_ i
          ]
        )
  toHtml (Input v l i (Dropdown opts)) =
    with
      div_
      [class__ "form-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> ( with
                 select_
                 [ class__ "form-control jsbClassEventInput",
                   id_ i
                 ]
                 opts'
             )
      )
    where
      opts' =
        mconcat $
          ( \o ->
              with
                option_
                ( bool
                    []
                    [selected_ "selected"]
                    (toText (toHtml o) == toText (toHtml v))
                )
                (toHtml o)
          )
            <$> opts
  toHtml (Input v l i (DropdownSum opts)) =
    with
      div_
      [class__ "form-group sumtype-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> ( with
                 select_
                 [ class__ "form-control jsbClassEventInput jsbClassEventShowSum",
                   id_ i
                 ]
                 opts'
             )
      )
    where
      opts' =
        mconcat $
          ( \o ->
              with
                option_
                (bool [] [selected_ "selected"] (toText (toHtml o) == toText (toHtml v)))
                (toHtml o)
          )
            <$> opts
  toHtml (Input v l i (Datalist opts listId)) =
    with
      div_
      [class__ "form-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> input_
            [ type_ "text",
              class__ "form-control jsbClassEventInput",
              id_ i,
              list_ listId
              -- the datalist concept in html assumes initial state is a null
              -- and doesn't present the list if it has a value alreadyx
              -- , value_ (show $ toHtml v)
            ]
          <> with
            datalist_
            [id_ listId]
            ( mconcat $
                ( \o ->
                    with
                      option_
                      ( bool
                          []
                          [selected_ "selected"]
                          (toText (toHtml o) == toText (toHtml v))
                      )
                      (toHtml o)
                )
                  <$> opts
            )
      )
  -- FIXME: How can you refactor to eliminate this polymorphic wart?
  toHtml (Input _ l i (Checkbox checked)) =
    with
      div_
      [class__ "form-check"]
      ( input_
          ( [ type_ "checkbox",
              class__ "form-check-input jsbClassEventCheckbox",
              id_ i
            ]
              <> bool [] [checked_] checked
          )
          <> (maybe mempty (with label_ [for_ i, class__ "form-check-label"] . toHtml) l)
      )
  toHtml (Input _ l i (Toggle pushed lab)) =
    with
      div_
      [class__ "form-group"]
      ( (maybe mempty (with label_ [for_ i] . toHtml) l)
          <> input_
            ( [ type_ "button",
                class__ "btn btn-primary btn-sm jsbClassEventToggle",
                data_ "toggle" "button",
                id_ i,
                makeAttribute "aria-pressed" (bool "false" "true" pushed)
              ]
                <> (maybe [] (\l' -> [value_ l']) lab)
                <> bool [] [checked_] pushed
            )
      )
  toHtml (Input _ l i Button) =
    with
      div_
      [class__ "form-group"]
      ( input_
          ( [ type_ "button",
              id_ i,
              class__ "btn btn-primary btn-sm jsbClassEventButton",
              value_ (fromMaybe "button" l)
            ]
          )
      )

  toHtmlRaw = toHtml