{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Datarekisteri.Frontend.Widgets where

import Data.Text (Text)

import Yesod

type Widget' a = WidgetFor a ()

submitButton :: Text -> Widget' a
submitButton text = do
    toWidget [hamlet|<input type="submit" value="#{text}">|]

submitButtonBad :: Text -> Widget' a
submitButtonBad text = do
    buttonId <- newIdent
    toWidget [hamlet|<input id="#{buttonId}" type="submit" value="#{text}">|]
    toWidget [lucius|
        input[type="submit"]##{buttonId} {
            background-color: #8a003a;
        }
        input[type="submit"]##{buttonId}:hover {
            background-color: #aa3968;
        }
    |]

keyValueTable :: (ToWidget site a, ToWidget site b) => [(a, b)] -> Widget' site
keyValueTable rows = do
    tableClass <- newIdent
    [whamlet|
        <table .#{tableClass}>
            $forall row <- rows
                <tr>
                    <th scope="row">^{fst row}
                    <td>^{snd row}
    |]
    toWidget [lucius|
        .#{tableClass} {
            th { text-align: right; }
            td { text-align: left; }
        }
    |]

form :: Route a -> Enctype -> Widget' a -> Widget' a
form route enctype content = do
    formClass <- newIdent
    [whamlet|
        <form .#{formClass} action="@{route}" method="post" enctype="#{enctype}">
            ^{content}
    |]
    toWidget [lucius|
        form.#{formClass} {
          max-width: min(30em,100%);
          label {
            display: block;
            padding-top: 0.3em;
            padding-bottom: 0.3em;
          }
          textarea {
            width: 100%;
            padding: 0.4em;
            margin-top: 0.3em;
            margin-bottom: 0.3em;
          }
          input {
            width: 100%;
            padding: 0.4em;
            margin-top: 0.3em;
            margin-bottom: 0.3em;
            border-radius: 0.25em;
          }
          input:invalid {
            border-color: #8a003a;
          }
          input[type="submit"] {
            background-color: #00838a;
            color: #ffffff;
            padding: 0.5em 1em;
            border: 0;
            cursor: pointer;
            font-weight: bold;
          }
          input[type="submit"]:hover {
            background-color: #339ca1;
          }
        }
    |]

table' :: [Widget' a] -> [[Widget' a]] -> Widget' a
table' header rows = do
    tableClass <- newIdent
    thClass <- newIdent
    [whamlet|
      <table .#{tableClass}>
        <thead>
          <tr>
            $forall cell <- header
              <th .#{thClass} scope="col">
                ^{cell}
      $forall row <- rows
        <tr>
          $forall cell <- row
            <td>
              ^{cell}
    |]
    toWidget [lucius|
        table.#{tableClass} {
          th[scope="col"].#{thClass} {
            text-align: center;
          }
        }
    |]

table :: forall a site. ToTableRow site a => [a] -> Widget' site
table rows = table' (tableHeader (undefined :: a)) (toCells <$> rows)

class ToTableRow site a where
    tableHeader :: a -> [Widget' site]
    toCells :: a -> [Widget' site]