{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}


module Lucid.Forms ( GToHtmlForm(..)
                   , GToHtmlFormInput(..)
                   , ToHtmlForm(..)
                   , ToHtmlFormInput(..)
                   , HtmlFormOptions(..)
                   ) where

import           Data.Maybe           (maybeToList)
import           Data.Proxy           (Proxy (..))
import           Data.Text            (Text)
import qualified Data.Text            as T
import           Data.Time            (Day)
import           GHC.Generics         (C1, D1, Generic (Rep), K1, Meta (..),
                                       Rec0, S1, U1, type (:*:), type (:+:))
import           GHC.TypeLits         (KnownSymbol, symbolVal)
import           Lucid                (Html, HtmlT, ToHtml (toHtml), action_,
                                       div_, for_, form_, id_, input_, label_,
                                       method_, name_, placeholder_, type_,
                                       value_)
import           Lucid.Base           (relaxHtmlT)
import           Text.ProtocolBuffers (Default (defaultValue))

class GToHtmlFormInput a where
  gtoHtmlFormInput :: Text -> Proxy (a p) -> Html ()

instance (KnownSymbol name)
  => GToHtmlFormInput (C1 (MetaCons name f s) U1) where
  gtoHtmlFormInput group _ = do
    input_ [type_ "radio", id_ name, value_ name, name_ group] -- need a shared name for all options here
    label_ [for_ name] (toHtml name)
    where name = T.pack (symbolVal (Proxy @name))

instance (GToHtmlFormInput l, GToHtmlFormInput r) => GToHtmlFormInput (l :+: r) where
  gtoHtmlFormInput group _ = do
    gtoHtmlFormInput group (Proxy @(l _))
    gtoHtmlFormInput group (Proxy @(r _))

-- | ignore constructor & type metainfo
instance GToHtmlFormInput a => GToHtmlFormInput (D1 r a) where
  gtoHtmlFormInput group _ = gtoHtmlFormInput group (Proxy @(a _))

-- | class for things which can be (single) options (i.e. a single input-tag or
-- | a group of radio buttons) in an html form
class ToHtmlFormInput a where
  toFormInput :: Text -> Proxy a -> Html ()
  default toFormInput :: (GToHtmlFormInput (Rep a)) => Text -> Proxy a -> Html ()
  toFormInput group p = gtoHtmlFormInput group (Proxy @(Rep a _))

instance ToHtmlFormInput Text where
  toFormInput name _ = input_ [type_ "text", name_ name, placeholder_ name]
instance ToHtmlFormInput Day where
  toFormInput name _ = input_ [type_ "text", name_ name]
instance ToHtmlFormInput Bool where
  toFormInput name _ = input_ [type_ "checkbox", name_ name]
instance ToHtmlFormInput (Maybe Bool) where
  toFormInput name _ = input_ [type_ "checkbox", name_ name]


-- | generic conversion of record data types to input forms
class GToHtmlForm a where
  gtoHtmlForm :: Proxy (a p) -> Html ()

-- | each record field is a form input
instance (KnownSymbol name, ToHtmlFormInput a)
  => GToHtmlForm (S1 (MetaSel (Just name) su ss ds) (Rec0 a)) where
  gtoHtmlForm _ = toFormInput (T.pack (symbolVal (Proxy @name))) (Proxy @a)

-- | just chain all fields
instance (GToHtmlForm l, GToHtmlForm r) => GToHtmlForm (l :*: r) where
  gtoHtmlForm _ = do
    gtoHtmlForm (Proxy @(l _))
    gtoHtmlForm (Proxy @(r _))

-- | ignore constructor & type metainfo
instance GToHtmlForm a => GToHtmlForm (D1 r a) where
  gtoHtmlForm _ = gtoHtmlForm (Proxy @(a _))
instance GToHtmlForm a => GToHtmlForm (C1 r a) where
  gtoHtmlForm _ = gtoHtmlForm (Proxy @(a _))

-- | class for things which can be entered via html forms
class ToHtmlForm a where
  toHtmlForm :: Monad m => HtmlFormOptions -> Proxy a -> HtmlT m ()
  default toHtmlForm :: (GToHtmlForm (Rep a), Monad m) => HtmlFormOptions -> Proxy a -> HtmlT m ()
  toHtmlForm options = relaxHtmlT . genericToHtmlForm options

data HtmlFormOptions = HtmlFormOptions
  { formAction           :: Maybe Text
  , formMethod           :: Text
  , formSubmitButtonText :: Text
  }

defaultOptions ::HtmlFormOptions
defaultOptions = HtmlFormOptions Nothing "post" "Ok"

instance Default HtmlFormOptions where
  defaultValue = defaultOptions

genericToHtmlForm :: (GToHtmlForm (Rep a2)) => HtmlFormOptions -> Proxy a2 -> Html ()
genericToHtmlForm HtmlFormOptions{..} (Proxy :: Proxy a) =
  form_ ((method_ formMethod) : maybeToList (fmap action_ formAction)) $ do
    gtoHtmlForm (Proxy @(Rep a _))
    input_ [type_ "submit", value_ formSubmitButtonText]