content: {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
  
  module Lucid.Rdash (
      indexPage
    , mkAlert
    , mkAlerts
    , mkHead
    , mkHeaderBar
    , mkIndexPage
    , mkMetaBox
    , mkMetaTitle
    , mkPageContent
    , mkPageWrapperOpen
    , mkSidebar
    , mkSidebarFooter
    , mkSidebarWrapper
    , mkWidget
    , mkWidgets
    , mkWidgetContent
    , mkWidgetIcon
    , sidebarMain
    , sidebarTitle
    , widget_
    , widgetBody_
    , spacer_
    , rdashCSS
    , SidebarItem(..)
    ) where
  
  import Control.Applicative ((<$>))
  import qualified Data.Text as T
  import Data.List
  
  import Lucid.Bootstrap3
  
  import Lucid hiding (toHtml)
  import qualified Lucid (toHtml)
  import Data.Monoid ((<>), mempty)
  
  toHtml :: Monad m => T.Text -> HtmlT m ()
  toHtml = Lucid.toHtml
  
  rdashCSS, sidebarMain, sidebarTitle :: Monad m => HtmlT m ()
  
  rdashCSS = link_ [rel_ "stylesheet",
                    href_  "https://cdn.diffusionkinetics.com/rdash-ui/1.0.1/css/rdash.css"]
  
  ariaHidden, tooltip_ :: Term arg result => arg -> result
  
  ariaHidden = term "aria-hidden"
  tooltip_ = term "tooltip"
  
  fa_ :: Monad m => T.Text -> HtmlT m ()
  fa_ x = i_ [class_ $ T.unwords ["fas", x]] (return ())
  
  aHash_ :: Monad m => HtmlT m () -> HtmlT m ()
  aHash_ = a_ [href_ "#"]
  
  sidebarTitle = span_ "NAVIGATION"
  sidebarMain  = a_ [href_ "#"] $ do
    "Dashboard"
    span_ [class_ "menu-icon glyphicon glyphicon-transfer"] (return ())
  
  mkPageWrapperOpen :: (Monad m) => HtmlT m () -> HtmlT m () -> HtmlT m ()
  mkPageWrapperOpen sbw cw = div_ [id_ "page-wrapper", class_ "open"] $ sbw >> cw
  
  mkSidebarWrapper :: (Monad m) => HtmlT m () -> HtmlT m () -> HtmlT m ()
  mkSidebarWrapper sb sbf = div_ [id_ "sidebar-wrapper"] $ sb >> sbf
  
  data SidebarItem = SidebarTitle T.Text
                   | SidebarLink
                      { itemText :: T.Text
                      , linkUrl ::  T.Text
                      , iconName :: T.Text
                      }
  
  mkSidebar :: forall m. (Monad m) => HtmlT m () -> [SidebarItem] -> HtmlT m ()
  mkSidebar sbm sbl = ul_ [class_ "sidebar"] $ do
    li_ [class_ "sidebar-main",
         id_ "toggle-sidebar",
         onclick_ "$('#page-wrapper').toggleClass('open');"] sbm
    let render :: SidebarItem -> HtmlT m ()
        render (SidebarTitle sbt)
          = li_ [class_ "sidebar-title"] $ span_ $ toHtml sbt
        render (SidebarLink t dest fa)
          = li_ [class_ "sidebar-list"]
            $ a_ [href_ dest]
            $ toHtml t <> i_ [class_ (fa<>" menu-icon")] mempty
    mapM_ render sbl
  
  mkSidebarFooter :: (Monad m) => HtmlT m () -> HtmlT m ()
  mkSidebarFooter footerItems = div_ [class_ "sidebar-footer"] footerItems
  
  mkHead :: (Monad m) => T.Text -> HtmlT m ()
  mkHead title = head_ $ do
    meta_ [charset_ "UTF-8"]
    meta_ [name_ "viewport", content_ "width=device-width"] -- TODO: add attribute initial-scale=1
    title_ (toHtml title)
    cdnFontAwesome
    cdnCSS
    rdashCSS
    cdnJqueryJS
    cdnBootstrapJS
  
  mkPageContent :: Monad m => HtmlT m () -> HtmlT m ()
  mkPageContent = div_ [id_ "content-wrapper"] . div_ [class_ "page-content"]
  
  mkHeaderBar :: Monad m => [HtmlT m ()] -> HtmlT m ()
  mkHeaderBar cols = div_ [class_ "row header"] (rowEven XS cols)
  
  mkUserBox :: Monad m => [HtmlT m ()] -> HtmlT m ()
  mkUserBox xs = div_ [class_ "user pull-right"] $ sequence_ xs
  
  mkItemDropdown :: Monad m => T.Text -> HtmlT m () -> HtmlT m ()
  mkItemDropdown icon x = div_ [class_ "item dropdown"] $ do
    a_ [ class_ "dropdown-toggle"
       , term "data-toggle" $ "dropdown"
       , href_ "#"] (i_ [class_ icon, ariaHidden "true"] (return ()))
    x
  
  mkDropdownMenu :: Monad m => HtmlT m () -> [[HtmlT m ()]] -> HtmlT m ()
  mkDropdownMenu hdr xs = ul_ [class_ "dropdown-menu dropdown-menu-right"] $ sequence_ dividedItems
    where
      mkLi = li_ . (a_ [href_ "#"])
      items = map (map mkLi) xs
      dividedItems = (li_ [class_ "dropdown-header"] hdr) : li_ [class_ "divider"] (return ()) :
        (concat $ intersperse [li_ [class_ "divider"] (return ())] items)
  
  mkIndexPage :: (Monad m) => HtmlT m () -> HtmlT m () -> HtmlT m ()
  mkIndexPage hd body = html_ [lang_ "en"] $ hd >> body
  
  mkMetaTitle :: Monad m => HtmlT m () -> HtmlT m ()
  mkMetaTitle = div_ [class_ "page"]
  
  mkMetaBreadcrumbLinks :: Monad m => HtmlT m () -> HtmlT m ()
  mkMetaBreadcrumbLinks = div_ [class_ "breadcrumb-links"]
  
  mkMetaBox :: Monad m => [HtmlT m ()] -> HtmlT m ()
  mkMetaBox = div_ [class_ "meta pull-left"] . sequence_
  
  mkAlerts :: Monad m => [HtmlT m ()] -> HtmlT m ()
  mkAlerts l = mkCol [(XS, 12)] (sequence_ l)
  
  mkAlert :: Monad m => T.Text -> HtmlT m () -> HtmlT m ()
  mkAlert alertType = div_ [class_ $ T.unwords ["alert", alertType]]
  
  mkWidgetIcon :: Monad m => T.Text -> T.Text -> HtmlT m ()
  mkWidgetIcon color icon =
    div_ [class_$ T.unwords ["widget-icon pull-left", color]] $ i_ [class_ icon] (return ())
  
  mkWidgetContent :: Monad m => HtmlT m () -> HtmlT m () -> HtmlT m ()
  mkWidgetContent title comment =
    div_ [class_ "widget-content pull-left"] $ do
    div_ [class_ "title"] title
    div_ [class_ "comment"] comment
  
  mkWidget :: Monad m => HtmlT m () -> HtmlT m () -> HtmlT m ()
  mkWidget wIcon wContent =
    widget_ $
     widgetBody_ $
      wIcon >> wContent >> div_ [class_ "clearfix"] (return ())
  
  mkWidgets :: Monad m => [[HtmlT m ()]] -> HtmlT m ()
  mkWidgets widgets =
    div_ [class_ "row"] . sequence_ $ intersperse spacer_ (map go widgets)
    where
      go = mapM_ (mkCol [(XS, 12), (MD, 6), (LG, 3)])
  
  spacer_ :: Monad m => HtmlT m ()
  spacer_ = div_ [class_ "spacer visible-xs"] $ return ()
  
  widget_ ::Monad m => HtmlT m () -> HtmlT m ()
  widget_ = div_ [class_ "widget"]
  
  widgetBody_ ::Monad m => HtmlT m () -> HtmlT m ()
  widgetBody_ = div_ [class_ "widget-body"]
  
  
  mkTable :: Monad m => HtmlT m () -> [[HtmlT m ()]] -> HtmlT m ()
  mkTable title content = mkCol [(LG, 6)] $ do
    div_ [class_ "widget"] $ do
      div_ [class_ "widget-header"] title
      div_ [class_ "widget-body medium no-padding"] $
        div_ [class_ "table-responsive"] $ table_ [class_ "table"] $ tbody_ (mapM_ (tr_ . (mapM_ td_)) content)
  
  mkTables :: Monad m => [HtmlT m ()] -> HtmlT m ()
  mkTables = div_ [class_ "row"] . sequence_
  
  indexPage :: (Monad m) => HtmlT m ()
  indexPage = do
    mkIndexPage hd body
    where
  
      -- SIDEBAR
      dashboardSI = SidebarLink ("Dashboard") "#" "tachometer"
      tablesSI    = SidebarLink ("Tables") "#" "table"
      sb = mkSidebar sidebarMain [SidebarTitle "NAVIGATION", dashboardSI, tablesSI]
      footerContent =
        rowEven XS
        [ a_ [href_ "https://github.com/rdash/rdash-barebones", target_ "blank_"] "Github"
        , a_ [href_ "#", target_ "blank_"] "About"
        , a_ [href_ "#"] "Support"]
      sbf = mkSidebarFooter footerContent
      sbw = mkSidebarWrapper sb sbf
  
      -- Header Bar
      userMenu = mkItemDropdown "fa fa-user-o" $ mkDropdownMenu "Joe Bloggs" [["Profile", "Menu Item"], ["Logout"]]
      bellMenu = mkItemDropdown "fa fa-bell-o" $ mkDropdownMenu "Notifications" [["Server Down!"]]
      userBox = mkUserBox [userMenu, bellMenu]
      metaBox = mkMetaBox [mkMetaTitle "Dashboard", mkMetaBreadcrumbLinks "Home / Dashboard"]
      hb = mkHeaderBar [metaBox, userBox]
  
      -- Main Content
      alerts = mkAlerts [ mkAlert "alert-success" "Thanks for visiting! Feel free to create pull requests to improve the dashboard!"
                        , mkAlert "alert-danger" "Found a bug? Create an issue with as many details as you can."]
      widgets = mkWidgets $
        [[ mkWidget (mkWidgetIcon "green" "fa fa-users") (mkWidgetContent (toHtml "80") (toHtml "Users"))
         , mkWidget (mkWidgetIcon "red" "fa fa-tasks") (mkWidgetContent (toHtml "16") (toHtml "Servers"))
         , mkWidget (mkWidgetIcon "orange" "fa fa-sitemap") (mkWidgetContent (toHtml "225") (toHtml "Documents"))]
        , [mkWidget (mkWidgetIcon "blue" "fa fa-support") (mkWidgetContent (toHtml "62") (toHtml "Tickets"))]]
  
      tables = mkTables [serversTable, usersTable, extrasTable, loadingTable]
  
      pcw = mkPageContent (hb >> alerts >> widgets >> tables)
  
      pgw = mkPageWrapperOpen sbw pcw
  
      body = body_ pgw
      hd = mkHead "Dashboard"
  
  
  serversTable :: Monad m => HtmlT m ()
  serversTable = mkTable lhs d
    where
      checked = span_ [class_ "text-success"] $ i_ [class_ "fa fa-check"] $ return ()
      warn = span_ [class_ "text-danger", tooltip_ "Server Down!"] $ i_ [class_ "fa fa-warning"] $ return ()
  
      d = [ ["RDVMPC001", "10.0.0.1", checked]
          , ["RDVMPC002", "10.1.0.1", warn]
          , ["RDVMPC003", "10.0.1.1", checked]
          , ["RDVMPC004", "10.1.1.1", checked]
          , ["RDVMPC005", "10.1.1.0", warn]]
      lhs = do
        fa_ "fa-tasks"
        " Servers "
        div_ [class_ "pull-right"] $ aHash_ "Manage"
  
  
  usersTable :: Monad m => HtmlT m ()
  usersTable = mkTable lhs d
    where
    d = [["1", "Joe Bloggs", "Super Admin", "AZ23045"]]
    lhs = do
      fa_ "fa-users"
      " Users "
      div_ [class_ "pull-right"] $
        input_ [type_ "text", placeholder_ "Search"]
  
  extrasTable :: Monad m => HtmlT m ()
  extrasTable = mkCol [(LG, 6)] $ do
    div_ [class_ "widget"] $ do
      div_ [class_ "widget-header"] lhs
      div_ [class_ "widget-body"] . div_ [class_ "widget-content"] . sequence_ $
        div_ [class_ "message"] <$> messages
    where
    lhs = do
      fa_ "fa-plus"
      " Extras "
      div_ [class_ "pull-right"] $ button_ "Button"
    messages =
      [ div_ [class_ "message"] $ span_ [class_ "error"] "Error message!"]
  
  loadingTable :: Monad m => HtmlT m ()
  loadingTable = mkCol [(LG, 6)] $ do
    div_ [class_ "widget"] $ do
      div_ [class_ "widget-header"] lhs
      div_ [class_ "widget-body"] loading
    where
      lhs = do
        fa_ "fa-cog fa-spin"
        " Loading Directive "
        div_ [class_ "pull-right"] $ a_ [href_ "#" ] "SpinKit"
      loading = div_ [class_ "loading"] $ do
        div_ [class_ "double-bounce1"] (return ())
        div_ [class_ "double-bounce2"] (return ())
  