{-# LANGUAGE
    OverloadedStrings
  , ScopedTypeVariables
  , FlexibleContexts
  #-}

module Templates.Master where

import Application.Types
import Templates.MainStyles
import Templates.MainScripts

import Data.Url
import Web.Page.Lucid
import Web.Routes.Nested hiding (FileExt (..), p_)
import qualified Network.Wai.Middleware.ContentType as FE
import qualified Data.Text as T
import Network.HTTP.Types
import Lucid

import Data.Monoid
import Data.Default
import Data.Markup
import Control.Monad.Trans
import Control.Monad.Reader.Class

-- | Render without @mainTemplate@
htmlLight :: ( MonadIO (Result m)
             , UrlReader T.Text m
             , MonadReader Env (Result m)
             ) => Status
               -> HtmlT m a
               -> FileExtListenerT (MiddlewareT (Result m)) (Result m) ()
htmlLight s content = do
  hostname <- envHostname <$> (lift ask)
  bs <- lift $ (runUrlReader $ renderBST content) $ T.pack hostname

  bytestringStatus FE.Html s [("Content-Type","text/html")] bs


-- | Shortcut for rendering with a template
html :: ( MonadReader Env m
        , MonadIO m
        ) => Maybe GlobalState
          -> HtmlT (ClarkUrlT m) ()
          -> FileExtListenerT (MiddlewareT m) m ()
html state content = htmlLight status200 $ mainTemplate state content


appendTitle :: WebPage (HtmlT m ()) T.Text
            -> T.Text
            -> WebPage (HtmlT m ()) T.Text
appendTitle page x = page { pageTitle = x <> " « " <> pageTitle page
                          }

masterPage :: ( Monad m
              , MonadReader Env m
              ) => WebPage (HtmlT (ClarkUrlT m) ()) T.Text
masterPage =
  let page :: (Monad m, MonadReader Env m) => WebPage (HtmlT (ClarkUrlT m) ()) T.Text
      page = def
  in page { afterStylesScripts = afterStylesScripts'
          , bodyScripts = bodyScripts'
          , styles = styles'
          , pageTitle = ("Clark Mining Tech" :: T.Text)
          , metaVars = do metaVars page
                          meta_ [httpEquiv_ "Content-Type", content_ "text/html; charset=UTF-8"]
                          meta_ [name_ "viewport", content_ "width=device-width, initial-scale=1.0, maximum-scale=1.0"]
                          meta_ [httpEquiv_ "X-UA-Compatible", content_ "IE=edge,chrome=1"]
          }
  where
    afterStylesScripts' = renderMarkup localStylesScripts
    localStylesScripts :: Monad m => LocalMarkupM (HtmlT (AbsoluteUrlT T.Text m) ())
    localStylesScripts = mconcat
      [ deploy JavaScript
          ("vendor/jquery/dist/jquery.min.js" :: T.Text)
      , deploy JavaScript
          ("vendor/semantic-ui/dist/semantic.min.js" :: T.Text)
      ]

    styles' = renderMarkup localStyles
           <> renderMarkup inlineStyles
    localStyles :: Monad m => LocalMarkupM (HtmlT (AbsoluteUrlT T.Text m) ())
    localStyles = mconcat
      [ deploy Css
          ("vendor/semantic-ui/dist/semantic.min.css" :: T.Text)
      ]
    inlineStyles :: Monad m => InlineMarkupM (HtmlT m ())
    inlineStyles = mconcat
      [ deploy Css mainStyles
      ]

    bodyScripts' = renderMarkup inlineBodyScripts
    inlineBodyScripts :: Monad m => InlineMarkupM (HtmlT m ())
    inlineBodyScripts = mconcat
      [ deploy JavaScript mainScripts
      ]


masterTemplate :: ( Monad m
                  , MonadReader Env m
                  ) => Maybe GlobalState
                    -> WebPage (HtmlT (ClarkUrlT m) ()) T.Text
                    -> HtmlT (ClarkUrlT m) ()
                    -> HtmlT (ClarkUrlT m) ()
masterTemplate state page content = template page $ do
  sideBar
  div_ [class_ "pusher"] $ do
    navBar

    div_ [ id_ "content"
         , class_ "ui grid padded"] $ do
      content
      div_ [ id_ "footer"
           , class_ "row"] $
        div_ [class_ "column sixteen wide center aligned"] $
          p_ [style_ "color: #fff;"] "Copyright © Lawrence R. Clark, 2015 - forever, yo"
  where
    sideBar = do
      root    <- lift $ plainUrl ""
      contact <- lift $ plainUrl "contact"
      about   <- lift $ plainUrl "about"

      nav_ [ id_ "sideBar"
           , class_ "ui sidebar inverted vertical menu"] $ do
        div_ [class_ "ui inverted transparent icon input item"] $ do
          i_ [class_ "search link icon"] ""
          input_ [placeholder_ "Search...", type_ "text", class_ "ui input"]
        a_ [ class_ (appendActiveWhen state HomeNav "item")
           , href_ root] $ do
          i_ [class_ "home icon"] ""
          "Home"
        a_ [ class_ (appendActiveWhen state (AboutNav Nothing) "item")
           , href_ about] $ do
          i_ [class_ "asterisk icon"] ""
          "About"
        a_ [ class_ (appendActiveWhen state ContactNav "item")
           , href_ contact] $ do
          i_ [class_ "mail icon"] ""
          "Contact"
    navBar = do
      root       <- lift $ plainUrl ""
      contact    <- lift $ plainUrl "contact"
      about      <- lift $ plainUrl "about"
      services   <- lift $ plainUrl "services"
      management <- lift $ plainUrl "about/management"

      nav_ [ id_ "navBar"
           , class_ "ui top fixed inverted menu"] $ do
        div_ [ id_ "navBar-menu-button"
             , class_ "item ui button icon"] $
          i_ [class_ "icon sidebar"] ""
        a_ [ class_ (appendActiveWhen state HomeNav "item")
           , href_ root] "Clark Mining Tech"
        div_ [ id_ "navBar-about-button"
             , class_ (appendActiveWhen state (AboutNav Nothing) "ui dropdown item")] $ do
          "About"
          i_ [class_ "dropdown icon"] ""
          div_ [ id_ "navBar-about"
               , class_ "menu"] $ do
            a_ [ class_ (appendActiveWhen state (AboutNav (Just ManagementNav)) "item")
               , href_ management] "Management"
        a_ [ id_ "navBar-services-button"
           , class_ "item"
           , href_ services] "Services"
        div_ [class_ "right menu"] $ do
          a_ [class_ (appendActiveWhen state ContactNav "item"), href_ contact] "Contact"
          div_ [class_ "item"] $
            div_ [class_ "ui inverted transparent icon input"] $ do
              input_ [placeholder_ "Search...", type_ "text"]
              i_ [class_ "search link icon"] ""

      div_ [ id_ "navBar-services"
           , class_ "ui fluid popup bottom left transition hidden"] $
        div_ [class_ "ui four column relaxed equal height divided grid"] $ do
          div_ [class_ "column"] $ do
            h4_ [class_ "ui header"] "Fabrics"
            div_ [class_ "ui link list"] $ do
              a_ [class_ "item"] "Cashmere"
              a_ [class_ "item"] "Linen"
              a_ [class_ "item"] "Cotton"
              a_ [class_ "item"] "Viscose"
          div_ [class_ "column"] $ do
            h4_ [class_ "ui header"] "Fabrics"
            div_ [class_ "ui link list"] $ do
              a_ [class_ "item"] "Cashmere"
              a_ [class_ "item"] "Linen"
              a_ [class_ "item"] "Cotton"
              a_ [class_ "item"] "Viscose"
          div_ [class_ "column"] $ do
            h4_ [class_ "ui header"] "Fabrics"
            div_ [class_ "ui link list"] $ do
              a_ [class_ "item"] "Cashmere"
              a_ [class_ "item"] "Linen"
              a_ [class_ "item"] "Cotton"
              a_ [class_ "item"] "Viscose"
          div_ [class_ "column"] $ do
            h4_ [class_ "ui header"] "Fabrics"
            div_ [class_ "ui link list"] $ do
              a_ [class_ "item"] "Cashmere"
              a_ [class_ "item"] "Linen"
              a_ [class_ "item"] "Cotton"
              a_ [class_ "item"] "Viscose"

mainTemplate :: ( Monad m
                , MonadReader Env m
                ) => Maybe GlobalState
                  -> HtmlT (ClarkUrlT m) ()
                  -> HtmlT (ClarkUrlT m) ()
mainTemplate state =
  masterTemplate state masterPage
