125 lines
3.2 KiB
Haskell
125 lines
3.2 KiB
Haskell
{-# 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]
|