gdritter repos inf-dict / master src / Render.hs
master

Tree @master (Download .tar.gz)

Render.hs @masterraw · history · blame

module Render where

import           Control.Monad (when)
import           Data.Monoid ((<>))
import           Data.Text (Text, pack)
import           Data.Text.Lazy (toStrict)
import           Lucid

import Markup
import Types

rPage :: Html () -> Text
rPage content = toStrict $ renderText $ doctypehtml_ $ do
  head_ $ do
    meta_ [ httpEquiv_ "Content-Type"
          , content_ "text/html; encoding=utf8;"
          ]
    link_ [ href_ "/static/main.css"
          , rel_ "stylesheet"
          , type_ "text/css"
          ]
    title_ "infinite negative dictionary"
  body_ $ do
    div_ [ class_ "header" ] $ do
      h1_ "Infinite Negative Dictionary"
    div_ [ class_ "menu" ] $ do
      menu
    div_ [ class_ "main" ] $ do
      content
    div_ [ class_ "footer" ] $ do
      "[what do I need here? copyright?]"

menu :: Html ()
menu = ul_ $ do
  li_ $ a_ [ href_ "/" ] "index"
  li_ $ a_ [ href_ "/lang" ] "languages"
  li_ $ a_ [ href_ "/word" ] "everything"
  li_ $ a_ [ href_ "/add" ] "add"
  li_ $ a_ [ href_ "/search" ] "search"

rEntries :: [Entry] -> Html ()
rEntries = mapM_ rEntry

rEntry :: Entry -> Html ()
rEntry e = div_ [ class_ "entry" ] $ do
  div_ [ class_ "word" ] $ toHtml (eWord e)
  div_ [ class_ "translit" ] $ toHtml (eTranslit e)
  div_ [ class_ "meaning" ] $ markup (eMeaning e)
  when (eNotes e /= "") $
    div_ [ class_ "notes" ] $ markup (eNotes e)
  ul_ [ class_ "links" ] $ do
    li_ $ a_ [ href_ (pack ("/word/" ++ show (eID e) ++ "/edit")) ] "edit"
    li_ $ a_ [ href_ (pack ("/word/" ++ show (eID e))) ] "link"

rSearch :: Html ()
rSearch = form_ [ name_ "search" ] $ do
  input_ [ type_ "text", name_ "query" ]

rAdd :: [Language] -> Html ()
rAdd ls = form_ [ name_ "add", action_ "/word/", method_ "POST" ] $ do
  div_ $ do
    label_ "Language: "
    select_ [ name_ "lang" ] $ sequence_
      [ option_ [ value_ (pack (show i)) ] $ toHtml n
      | Language { langId = i, langName = n } <- ls
      ]
  div_ $ do
    label_ "Word: "
    input_ [ type_ "text", name_ "word" ]
  div_ $ do
    label_ "Transliteration: "
    input_ [ type_ "text", name_ "translit" ]
  div_ $ do
    label_ "Meaning: "
    textarea_ [ rows_ "4", cols_ "100", name_ "meaning" ] ""
  div_ $ do
    label_ "Notes: "
    textarea_ [ rows_ "4", cols_ "100", name_ "notes" ] ""
  div_ $ input_ [ type_ "submit" ]


rEdit :: Integer -> [Language] -> Entry -> Html ()
rEdit w ls e = form_ [ name_ "edit"
                     , action_ (pack ("/word/" ++ show w))
                     , method_ "POST"
                     ] $ do
  div_ $ do
    label_ "Language: "
    select_ [ name_ "lang" ] $ sequence_
      [ option_ [ value_ (pack (show i))
                , select_ (if i == langId (eLanguage e)
                             then "true"
                             else "false")
                ] $ toHtml n
      | Language { langId = i, langName = n } <- ls
      ]
  div_ $ do
    label_ "Word: "
    input_ [ type_ "text"
           , name_ "word"
           , value_ (eWord e)
           ]
  div_ $ do
    label_ "Transliteration: "
    input_ [ type_ "text"
           , name_ "translit"
           , value_ (eTranslit e)
           ]
  div_ $ do
    label_ "Meaning: "
    textarea_ [ rows_ "4", cols_ "100", name_ "meaning" ] $
      toHtml (eMeaning e)
  div_ $ do
    label_ "Notes: "
    textarea_ [ rows_ "4", cols_ "100", name_ "notes" ] $
      toHtml (eNotes e)
  div_ $ input_ [ type_ "submit" ]

rLangList :: [Language] -> Html ()
rLangList ls = do
  ul_ [ class_ "langs" ] $ do
    sequence_ [ li_ $ a_ [ href_ ("/lang/" <> langName l) ]
                         (toHtml (langName l))
              | l <- ls
              ]