----------------------------------------------------------------------------
--- This library contains some operations to generate web pages
--- rendered with [Bootstrap version 4](https://getbootstrap.com/).
---
--- @author Michael Hanus
--- @version January 2024
----------------------------------------------------------------------------

module HTML.Styles.Bootstrap4
 ( bootstrapPage, bootstrapPage2, titledSideMenu
 , primButton, primSmButton, scndButton, scndSmButton
 , infoButton, infoSmButton
 , hrefPrimButton, hrefPrimSmButton, hrefScndButton, hrefScndSmButton
 , hrefInfoButton, hrefInfoSmButton, hrefSuccButton, hrefSuccSmButton
 , hrefWarnButton, hrefWarnSmButton, hrefDangButton, hrefDangSmButton
 , hrefLightButton, hrefLightSmButton, hrefDarkButton, hrefDarkSmButton
 , hrefPrimBlock, hrefScndBlock, hrefInfoBlock
 , hrefPrimSmBlock, hrefScndSmBlock, hrefInfoSmBlock
 , hrefPrimBadge, hrefScndBadge, hrefSuccBadge, hrefInfoBadge
 , hrefWarnBadge, hrefDangBadge, hrefLightBadge, hrefDarkBadge
 , ehrefPrimBadge, ehrefScndBadge, ehrefSuccBadge, ehrefInfoBadge
 , ehrefWarnBadge, ehrefDangBadge, ehrefLightBadge, ehrefDarkBadge
 , hrefNav, hrefNavActive, ehrefNav, ehref, eTarget
 , kbdInput
 , staticButton
 , stdModal, modalLaunchPrimButton, modalClosePrimButton, scriptShowModal
 ) where

import HTML.Base

----------------------------------------------------------------------------
--- An HTML page rendered with bootstrap with a fixed top navigation bar.
--- @param favicon   - the icon file `favicon.ico` (when empty not included)
--- @param styles    - the style files to be included (typically,
---                    `css/bootstrap.min.css`)
--- @param jsincludes - the JavaScript files to be included (typically,
---                     `.../jquery.js`, `js/bootstrap.min.js`)
--- @param title   - the title of the form
--- @param brand   - the brand shown top left (a URL/title pair)
--- @lefttopmenu   - the menu shown in the left side of the top navigation bar
--- @righttopmenu  - the menu shown in the right side of the top navigation bar
---                  (could be empty)
--- @param columns - number of columns for the left-side menu
---                  (if columns==0, then the left-side menu is omitted)
--- @param sidemenu - the menu shown at the left-side of the main document
---                   (maybe created with 'titledSideMenu')
--- @param header   - the main header (will be rendered with jumbotron style)
--- @param contents - the main contents of the document
--- @param footer   - the footer of the document
bootstrapPage :: String -> [String] -> [String] -> String -> (String,[BaseHtml])
              -> [[BaseHtml]] -> [[BaseHtml]] -> Int -> [BaseHtml] -> [BaseHtml]
              -> [BaseHtml] -> [BaseHtml] -> HtmlPage
bootstrapPage favicon styles jsincludes title brandurltitle lefttopmenu
              righttopmenu leftcols sidemenu header contents footer =
  bootstrapPage2 favicon styles jsincludes title brandurltitle
                 (addNavItemClass lefttopmenu) (addNavItemClass righttopmenu)
                 leftcols sidemenu header contents footer
 where
  addNavItemClass = map (\i -> ("nav-item", i))

--- An HTML page rendered with bootstrap with a fixed top navigation bar
--- and individual classes for the top menu items.
--- @param favicon   - the icon file `favicon.ico` (when empty not included)
--- @param styles    - the style files to be included (typically,
---                    `css/bootstrap.min.css`)
--- @param jsincludes - the JavaScript files to be included (typically,
---                     `.../jquery.js`, `js/bootstrap.min.js`)
--- @param title   - the title of the form
--- @param brand   - the brand shown top left (a URL/title pair)
--- @lefttopmenu   - the menu shown in the left side of the top navigation bar
---                  (with class attribute for the menu items)
--- @righttopmenu  - the menu shown in the right side of the top navigation bar
---                  (with class attribute for the menu items, could be empty)
--- @param columns - number of columns for the left-side menu
---                  (if columns==0, then the left-side menu is omitted)
--- @param sidemenu - the menu shown at the left-side of the main document
---                   (maybe created with 'titledSideMenu')
--- @param header   - the main header (will be rendered with jumbotron style)
--- @param contents - the main contents of the document
--- @param footer   - the footer of the document
bootstrapPage2 :: String -> [String] -> [String] -> String
               -> (String,[BaseHtml]) -> [(String,[BaseHtml])]
               -> [(String,[BaseHtml])] -> Int -> [BaseHtml] -> [BaseHtml]
               -> [BaseHtml] -> [BaseHtml] -> HtmlPage
bootstrapPage2 favicon styles jsincludes title brandurltitle
  lefttopmenu righttopmenu leftcols sidemenu header contents footer =
  HtmlPage title
           ([pageEnc "utf-8", responsiveView] ++ icon ++
             map pageCSS styles)
           (bootstrapBody jsincludes brandurltitle
                          lefttopmenu righttopmenu
                          leftcols sidemenu header contents footer)
 where
  -- for a better view on handheld devices:
  responsiveView =
    pageMetaInfo
      [("name","viewport"),
       ("content","width=device-width, initial-scale=1, shrink-to-fit=no")]

  icon = if null favicon
           then []
           else [pageLinkInfo [("rel","shortcut icon"), ("href",favicon)]]

--- Create body of HTML page. Used by `bootstrapPage`.
bootstrapBody ::
  HTML h => [String] -> (String,[h]) -> [(String,[h])] -> [(String,[h])]
         -> Int -> [h] -> [h] -> [h] -> [h] -> [h]
bootstrapBody jsincludes brandurltitle lefttopmenu righttopmenu
              leftcols sidemenu header contents footerdoc =
  topNavigationBar brandurltitle lefttopmenu righttopmenu ++
  [blockstyle "container-fluid"
     ([blockstyle "row"
        (if leftcols==0
           then [blockstyle (bsCols 12)
                   (headerRow ++ contents)]
           else [blockstyle (bsCols leftcols)
                   [blockstyle "card" sidemenu],
                 blockstyle (bsCols (12-leftcols))
                   (headerRow ++ contents)])] ++
       if null footerdoc
         then []
         else [hrule, footer footerdoc])] ++
   -- JavaScript includes placed at the end so page loads faster:
  map (\n -> htmlStruct "script" [("src",n)] []) jsincludes
 where
  bsCols n = "col-sm-" ++ show n ++ " " ++ "col-md-" ++ show n

  -- header row:
  headerRow = if null header
                then []
                else [htmlStruct "header" [("class","jumbotron")] header]


-- Navigation bar at the top. The first argument is a header element
-- put at the left, the second and third arguments are the left
-- and right menus which will be collapsed if the page is two small.
topNavigationBar ::
  HTML h =>  (String,[h]) -> [(String,[h])] -> [(String,[h])] -> [h]
topNavigationBar (brandurl,brandtitle) leftmenu rightmenu =
  [htmlStruct "nav"
    [("class","navbar navbar-expand-md navbar-dark fixed-top bg-dark")]
    [href brandurl brandtitle `addClass` "navbar-brand",
     htmlStruct "button"
       [("type","button"),("class","navbar-toggler"),
        ("data-toggle","collapse"),
        ("data-target","#topnavbar"),
        ("aria-expanded","false"),
        ("aria-controls","topnavbar"),
        ("aria-label","Toggle navigation")]
       [textstyle "navbar-toggler-icon" ""],
     htmlStruct "div" [("id","topnavbar"),
                       ("class","collapse navbar-collapse")] $
       [ulistWithItemClass "navbar-nav mr-auto" leftmenu] ++
       if null rightmenu
         then []
         else [ulistWithItemClass "navbar-nav navbar-right" rightmenu]]]

--- Create a side menu containing a title and a list of items:
titledSideMenu :: HTML h => String -> [[h]] -> [h]
titledSideMenu title items =
  (if null title
     then []
     else [h5 [htxt title]]) ++
  [ulistWithClass "nav flex-column" "nav-item" items]

----------------------------------------------------------------------------
-- Some buttons:

--- Primary input button.
primButton :: String -> HtmlHandler -> HtmlExp
primButton label handler =
  button label handler `addClass` "btn btn-primary"

--- Small primary input button.
primSmButton :: String -> HtmlHandler -> HtmlExp
primSmButton label handler =
  button label handler `addClass` "btn btn-sm btn-primary"

--- Secondary input button.
scndButton :: String -> HtmlHandler -> HtmlExp
scndButton label handler =
  button label handler `addClass` "btn btn-secondary"

--- Small secondary input button.
scndSmButton :: String -> HtmlHandler -> HtmlExp
scndSmButton label handler =
  button label handler `addClass` "btn btn-sm btn-secondary"

--- Info input button.
infoButton :: String -> HtmlHandler -> HtmlExp
infoButton label handler =
  button label handler `addClass` "btn btn-info"

--- Small info input button.
infoSmButton :: String -> HtmlHandler -> HtmlExp
infoSmButton label handler =
  button label handler `addClass` "btn btn-sm btn-info"

----------------------------------------------------------------------------
-- Renderings for hypertext references.

--- Hypertext reference rendered as a primary button.
hrefPrimButton :: HTML h => String -> [h] -> h
hrefPrimButton ref hexps =
  href ref hexps `addClass` "btn btn-primary"

--- Hypertext reference rendered as a small primary button.
hrefPrimSmButton :: HTML h => String -> [h] -> h
hrefPrimSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-primary"

--- Hypertext reference rendered as a secondary button.
hrefScndButton :: HTML h => String -> [h] -> h
hrefScndButton ref hexps =
  href ref hexps `addClass` "btn btn-secondary"

--- Hypertext reference rendered as a small secondary button.
hrefScndSmButton :: HTML h => String -> [h] -> h
hrefScndSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-secondary"

--- Hypertext reference rendered as an info button.
hrefInfoButton :: HTML h => String -> [h] -> h
hrefInfoButton ref hexps =
  href ref hexps `addClass` "btn btn-info"

--- Hypertext reference rendered as a small secondary button.
hrefInfoSmButton :: HTML h => String -> [h] -> h
hrefInfoSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-info"

--- Hypertext reference rendered as a success button.
hrefSuccButton :: HTML h => String -> [h] -> h
hrefSuccButton ref hexps =
  href ref hexps `addClass` "btn btn-success"

--- Hypertext reference rendered as a small success button.
hrefSuccSmButton :: HTML h => String -> [h] -> h
hrefSuccSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-success"

--- Hypertext reference rendered as a warning button.
hrefWarnButton :: HTML h => String -> [h] -> h
hrefWarnButton ref hexps =
  href ref hexps `addClass` "btn btn-warning"

--- Hypertext reference rendered as a small warning button.
hrefWarnSmButton :: HTML h => String -> [h] -> h
hrefWarnSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-warning"

--- Hypertext reference rendered as a danger button.
hrefDangButton :: HTML h => String -> [h] -> h
hrefDangButton ref hexps =
  href ref hexps `addClass` "btn btn-danger"

--- Hypertext reference rendered as a small danger button.
hrefDangSmButton :: HTML h => String -> [h] -> h
hrefDangSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-danger"

--- Hypertext reference rendered as a light button.
hrefLightButton :: HTML h => String -> [h] -> h
hrefLightButton ref hexps =
  href ref hexps `addClass` "btn btn-light"

--- Hypertext reference rendered as a small light button.
hrefLightSmButton :: HTML h => String -> [h] -> h
hrefLightSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-light"

--- Hypertext reference rendered as a dark button.
hrefDarkButton :: HTML h => String -> [h] -> h
hrefDarkButton ref hexps =
  href ref hexps `addClass` "btn btn-dark"

--- Hypertext reference rendered as a small dark button.
hrefDarkSmButton :: HTML h => String -> [h] -> h
hrefDarkSmButton ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-dark"


-- Hypertext reference rendered as a primary block button.
hrefPrimBlock :: HTML h => String -> [h] -> h
hrefPrimBlock ref hexps =
  href ref hexps `addClass` "btn btn-primary btn-block"

-- Hypertext reference rendered as a secondary block button.
hrefScndBlock :: HTML h => String -> [h] -> h
hrefScndBlock ref hexps =
  href ref hexps `addClass` "btn btn-secondary btn-block"

--- Hypertext reference rendered as an info block button.
hrefInfoBlock :: HTML h => String -> [h] -> h
hrefInfoBlock ref hexps =
  href ref hexps `addClass` "btn btn-info btn-block"

-- Hypertext reference rendered as a small primary block button.
hrefPrimSmBlock :: HTML h => String -> [h] -> h
hrefPrimSmBlock ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-primary btn-block"

-- Hypertext reference rendered as a small secondary block button.
hrefScndSmBlock :: HTML h => String -> [h] -> h
hrefScndSmBlock ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-secondary btn-block"

-- Hypertext reference rendered as a small info block button.
hrefInfoSmBlock :: HTML h => String -> [h] -> h
hrefInfoSmBlock ref hexps =
  href ref hexps `addClass` "btn btn-sm btn-info btn-block"

----------------------------------------------------------------------------
-- Badges

--- Hypertext reference rendered as a primary badge.
hrefPrimBadge :: HTML h => String -> [h] -> h
hrefPrimBadge ref hexps = href ref hexps `addClass` "badge badge-primary"

--- Hypertext reference rendered as a secondary badge.
hrefScndBadge :: HTML h => String -> [h] -> h
hrefScndBadge ref hexps = href ref hexps `addClass` "badge badge-secondary"

--- Hypertext reference rendered as a success badge.
hrefSuccBadge :: HTML h => String -> [h] -> h
hrefSuccBadge ref hexps = href ref hexps `addClass` "badge badge-success"

--- Hypertext reference rendered as an info badge.
hrefInfoBadge :: HTML h => String -> [h] -> h
hrefInfoBadge ref hexps = href ref hexps `addClass` "badge badge-info"

--- Hypertext reference rendered as a warning badge.
hrefWarnBadge :: HTML h => String -> [h] -> h
hrefWarnBadge ref hexps = href ref hexps `addClass` "badge badge-warning"

--- Hypertext reference rendered as a danger badge.
hrefDangBadge :: HTML h => String -> [h] -> h
hrefDangBadge ref hexps = href ref hexps `addClass` "badge badge-danger"

--- Hypertext reference rendered as a light badge.
hrefLightBadge :: HTML h => String -> [h] -> h
hrefLightBadge ref hexps = href ref hexps `addClass` "badge badge-light"

--- Hypertext reference rendered as a dark badge.
hrefDarkBadge :: HTML h => String -> [h] -> h
hrefDarkBadge ref hexps = href ref hexps `addClass` "badge badge-dark"

--- External hypertext reference rendered as a primary badge.
ehrefPrimBadge :: HTML h => String -> [h] -> h
ehrefPrimBadge ref hexps = eTarget $ hrefPrimBadge ref hexps

--- External hypertext reference rendered as a secondary badge.
ehrefScndBadge :: HTML h => String -> [h] -> h
ehrefScndBadge ref hexps = eTarget $ hrefScndBadge ref hexps

--- External hypertext reference rendered as a success badge.
ehrefSuccBadge :: HTML h => String -> [h] -> h
ehrefSuccBadge ref hexps = eTarget $ hrefSuccBadge ref hexps

--- External hypertext reference rendered as an info badge.
ehrefInfoBadge :: HTML h => String -> [h] -> h
ehrefInfoBadge ref hexps = eTarget $ hrefInfoBadge ref hexps

--- External hypertext reference rendered as a warning badge.
ehrefWarnBadge :: HTML h => String -> [h] -> h
ehrefWarnBadge ref hexps = eTarget $ hrefWarnBadge ref hexps

--- External hypertext reference rendered as a danger badge.
ehrefDangBadge :: HTML h => String -> [h] -> h
ehrefDangBadge ref hexps = eTarget $ hrefDangBadge ref hexps

--- External hypertext reference rendered as a light badge.
ehrefLightBadge :: HTML h => String -> [h] -> h
ehrefLightBadge ref hexps = eTarget $ hrefLightBadge ref hexps

--- External hypertext reference rendered as a dark badge.
ehrefDarkBadge :: HTML h => String -> [h] -> h
ehrefDarkBadge ref hexps = eTarget $ hrefDarkBadge ref hexps

----------------------------------------------------------------------------
-- Navigation links

--- Hypertext reference in navigations.
hrefNav :: HTML h => String -> [h] -> h
hrefNav url hexp = href url hexp `addClass` "nav-link"

--- Active hypertext reference in navigations.
hrefNavActive :: HTML h => String -> [h] -> h
hrefNavActive url hexp = ehref url hexp `addClass` "nav-link active"

--- External hypertext reference in navigations.
ehrefNav :: HTML h => String -> [h] -> h
ehrefNav url hexp = ehref url hexp `addClass` "nav-link"

--- An external hypertext reference which opens on a new page.
ehref :: HTML h => String -> [h] -> h
ehref ref hexp = eTarget $ href ref hexp

--- Transforms a hypertext reference into an external one
--- which opens on a new page.
--- Basically, the attribute `target="_blank"` is added.
eTarget :: HTML h => h -> h
eTarget hexp = hexp `addAttr` ("target","_blank")

--------------------------------------------------------------------------

--- Render an HTML expression as keyboard or user input.
kbdInput :: HTML h => [h] -> h
kbdInput = htmlStruct "kbd" []

----------------------------------------------------------------------------
-- Support for modal dialogs.

-- A static button (i.e., not a submit button of a form) of type `button`.
staticButton :: HTML h => [h] -> h
staticButton = htmlStruct "button" [("type","button")]

-- The basic modal structure:
modal :: HTML h => String -> String -> [h] -> h
modal modalId labelId = htmlStruct "div"
  [("class","modal fade")
  ,("id",modalId)
  ,("tabindex","-1")
  ,("role","dialog")
  ,("aria-labelledby",labelId)
  ,("aria-hidden","true")]

modalDialog :: HTML h => [h] -> h
modalDialog = htmlStruct "div" [("class","modal-dialog")]

modalContent :: HTML h => [h] -> h
modalContent = htmlStruct "div" [("class","modal-content")]

modalHeader :: HTML h => [h] -> h
modalHeader = htmlStruct "div" [("class","modal-header")]

modalBody :: HTML h => [h] -> h
modalBody = htmlStruct "div" [("class","modal-body")]

modalFooter :: HTML h => [h] -> h
modalFooter = htmlStruct "div" [("class","modal-footer")]

modalDismiss :: (String,String)
modalDismiss = ("data-dismiss","modal")

modalToggle :: (String,String)
modalToggle = ("data-toggle","modal")

stdModalClose :: HTML h => h
stdModalClose =
  staticButton [htmlText "×"]
   `addAttrs` [ ("class","close"), modalDismiss, ("aria-hidden","true")]

--- Defining a modal dialog where a modal id, the title, body, and footer
--- HTML expressions are provided.
--- If the first argument is `True`, then the modal dialog
--- will not close when clicking outside it.
stdModal :: HTML h => Bool -> String -> [h] -> [h] -> [h] -> h
stdModal staticbackdrop modalId title body footer =
  modal modalId labelId
    [modalDialog
      [modalContent
        [modalHeader
          [ htmlStruct "h5" [("class","modal-title")] title
              `addAttr` ("id",labelId)
          , stdModalClose]
        , modalBody body
        , modalFooter footer]]]
   `addAttrs`
     (if staticbackdrop
        then [("data-backdrop","static"), ("data-keyboard","false")]
        else [])
 where labelId = modalId ++ "Label"

--- A primary button to launch a modal dialog where the modal id and
--- the button text are provided.
modalLaunchPrimButton :: HTML h => String -> String -> h
modalLaunchPrimButton modalid btitle =
  staticButton [htxt btitle]
    `addAttrs` [ ("class","btn btn-primary"), ("data-toggle", "modal")
               , ("data-target", '#':modalid)]

--- A primary button to close a modal dialog to be used
--- inside the modal definition. The argument is the button text.
modalClosePrimButton :: HTML h => String -> h
modalClosePrimButton s =
  staticButton [ htxt s]
    `addAttrs` [ ("class","btn btn-primary"), ("data-dismiss","modal") ]

--- A JavaScript element which can be put at the end of the page body
--- in order to show a modal defined in the page after the page is loaded.
scriptShowModal :: String -> [BaseHtml]
scriptShowModal modalid =
  [hStruct "script"
    [htmlText $ "$(document).ready(function(){ $(\"#" ++ modalid ++
                "\").modal('show'); });"
    ]
  ]

----------------------------------------------------------------------------