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

module Server.ControlRoom where

import           Control.Monad.IO.Class      (MonadIO (liftIO))
import           Data.Maybe                  (maybeToList)
import           Data.Swagger                (ToSchema (..))
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           GTFS
import           Lucid
import           Servant
import           Servant.API                 (Capture, Get, JSON, NoContent,
                                              PlainText, Post, QueryParam,
                                              ReqBody, type (:<|>) ((:<|>)))
import           Servant.HTML.Lucid          (HTML)
import           Server.Util
import           Web.FormUrlEncoded          (ToForm)
import           Web.Internal.FormUrlEncoded (Form)

data TripList = TripList
  { tripListHeader :: Text
  , tripListType   :: Text
  , tripListTrips  :: [TripID]
  }

type ControlRoomAPI =
  Get '[HTML] TripList
  :<|> "irgendwo" :> ReqBody '[FormUrlEncoded] CalendarDate :> Post '[PlainText] Text

controlRoomServer :: Service ControlRoomAPI
controlRoomServer =
  (pure (TripList "hallo" "welt" []))
  :<|> (\text -> do
           liftIO $ putStrLn (show text)
           pure "hello"
       )




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 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 CalendarExceptionType


-- | 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 ToHtmlForm a where
  toHtmlForm :: Proxy a -> Html ()
  default toHtmlForm :: (GToHtmlForm (Rep a)) => Proxy a -> Html ()
  toHtmlForm = genericToHtmlForm defaultOptions

data HtmlFormOptions = HtmlFormOptions
  { htmlFormAction           :: Maybe Text
  , htmlFormMethod           :: Text
  , htmlFormSubmitButtonText :: Text
  }

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

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

instance ToHtmlForm CalendarDate