{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, QuasiQuotes #-}
module Theme where

import Clckwrks
import Clckwrks.Authenticate.Plugin   (authenticatePlugin)
import Clckwrks.Authenticate.URL      (AuthURL(Auth))
import Clckwrks.Types                 (NamedLink(..))
import Clckwrks.NavBar.API            (getNavBarData)
import Clckwrks.NavBar.Types          (NavBar(..), NavBarItem(..))
import Clckwrks.Monad
import Control.Monad.State            (get)
import Data.Maybe                     (fromMaybe)
import Data.Text.Lazy                 (Text)
import qualified Data.Text            as T
import Happstack.Authenticate.Password.URL (PasswordURL(UsernamePasswordCtrl), passwordAuthenticationMethod)
import HSP.JMacro
import HSP.XMLGenerator
import HSP.XML
import Language.Javascript.JMacro
import Language.Haskell.HSX.QQ        (hsx)
import Paths_clckwrks_theme_bootstrap (getDataDir)
import Web.Plugins.Core               (pluginName, getPluginRouteFn)

-- | this `Theme`
theme :: Theme
theme :: Theme
theme = Theme :: ThemeName -> [ThemeStyle] -> IO FilePath -> Theme
Theme
    { themeName :: ThemeName
themeName    = ThemeName
"bootstrap-theme"
    , themeStyles :: [ThemeStyle]
themeStyles  = [ThemeStyle
defaultStyle]
    , themeDataDir :: IO FilePath
themeDataDir = IO FilePath
getDataDir
    }

-- | function te generate the navigation bar
genNavBar :: GenXML (Clck ClckURL)
genNavBar :: GenXML (Clck ClckURL)
genNavBar =
    do NavBar
menu  <- ClckT ClckURL (ServerPartT IO) NavBar
-> XMLGenT (Clck ClckURL) NavBar
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ClckT ClckURL (ServerPartT IO) NavBar
forall (m :: * -> *) url.
(Functor m, MonadIO m) =>
ClckT url m NavBar
getNavBarData
       Maybe ThemeName
mName <- GetSiteName -> XMLGenT (Clck ClckURL) (EventResult GetSiteName)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query GetSiteName
GetSiteName
       Bool
openId <- GetEnableOpenId
-> XMLGenT (Clck ClckURL) (EventResult GetEnableOpenId)
forall event (m :: * -> *).
(QueryEvent event, GetAcidState m (EventState event), Functor m,
 MonadIO m, MonadState ClckState m) =>
event -> m (EventResult event)
query GetEnableOpenId
GetEnableOpenId
       ThemeName -> Bool -> NavBar -> GenXML (Clck ClckURL)
navBarHTML (ThemeName -> Maybe ThemeName -> ThemeName
forall a. a -> Maybe a -> a
fromMaybe ThemeName
"clckwrks" Maybe ThemeName
mName) Bool
openId NavBar
menu

-- | helper function to generate a navigation bar from the navigation bar data
navBarHTML :: T.Text   -- ^ brand
           -> Bool     -- ^ enable OpenId
           -> NavBar   -- ^ navigation bar links
           -> GenXML (Clck ClckURL)
navBarHTML :: ThemeName -> Bool -> NavBar -> GenXML (Clck ClckURL)
navBarHTML ThemeName
brand Bool
enableOpenId (NavBar [NavBarItem]
menuItems) = [hsx|
 <nav class="navbar navbar-default">
  <div class="container-fluid">
    -- Brand and toggle get grouped for better mobile display
    <div class="navbar-header">
      <button type="button" class="navbar-toggle collapsed" data-toggle="collapse" data-target="#bs-example-navbar-collapse-1">
        <span class="sr-only">Toggle navigation</span>
        <span class="icon-bar"></span>
        <span class="icon-bar"></span>
        <span class="icon-bar"></span>
      </button>
      <a class="navbar-brand" href="#"><% brand %></a>
    </div>

    -- Collect the nav links, forms, and other content for toggling
    <div class="collapse navbar-collapse" id="bs-example-navbar-collapse-1" ng-show="!isAuthenticated">
      -- this is where actual menu things go
      <ul class="nav navbar-nav">
        <% mapM mkNavBarItem menuItems %>
      </ul>

      <span ng-controller="UsernamePasswordCtrl">
       <up-login-inline />
      </span>

      -- navbar-text would make more sense than navbar-form, but it shifts the images funny. :-/
      <% if enableOpenId
            then [openIdHtml] else []
       %>

      <span up-authenticated=True class="navbar-left navbar-text">
       <a ng-click="logout()" href="">Logout {{claims.user.username}}</a>
      </span>
    </div> -- /.navbar-collapse
  </div>  -- /.container-fluid
 </nav>
    |]
  where
    openIdHtml :: GenXML (Clck ClckURL)
openIdHtml =
      [hsx| <span class="navbar-left navbar-btn" ng-controller="OpenIdCtrl" ng-show="!isAuthenticated">
              <openid-yahoo />
            </span>
          |]

mkNavBarItem :: NavBarItem -> GenXML (Clck ClckURL)
mkNavBarItem :: NavBarItem -> GenXML (Clck ClckURL)
mkNavBarItem (NBLink (NamedLink ThemeName
ttl ThemeName
lnk)) =
    [hsx| <li><a href=lnk><% ttl %></a></li> |]

-- | default template for this theme
defaultTemplate
  :: ( EmbedAsChild (ClckT ClckURL (ServerPartT IO)) headers
     , EmbedAsChild (ClckT ClckURL (ServerPartT IO)) body
     ) =>
     T.Text  -- ^ title to stick in \<title\> tag
  -> headers -- ^ extra values to stick in \<head\> tag
  -> body    -- ^ value to stick in \<body\> tag
  -> XMLGenT (ClckT ClckURL (ServerPartT IO)) XML
defaultTemplate :: ThemeName -> headers -> body -> XMLGenT (Clck ClckURL) XML
defaultTemplate ThemeName
ttl headers
hdr body
bdy = do
    ClckPlugins
p <- ClckState -> ClckPlugins
plugins (ClckState -> ClckPlugins)
-> XMLGenT (Clck ClckURL) ClckState
-> XMLGenT (Clck ClckURL) ClckPlugins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XMLGenT (Clck ClckURL) ClckState
forall s (m :: * -> *). MonadState s m => m s
get
    ~(Just AuthURL -> [(ThemeName, Maybe ThemeName)] -> ThemeName
authRouteFn) <- ClckPlugins
-> ThemeName
-> XMLGenT
     (Clck ClckURL)
     (Maybe (AuthURL -> [(ThemeName, Maybe ThemeName)] -> ThemeName))
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> ThemeName
-> m (Maybe (url -> [(ThemeName, Maybe ThemeName)] -> ThemeName))
getPluginRouteFn ClckPlugins
p (Plugin
  AuthURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> ThemeName
forall url theme n hook config st.
Plugin url theme n hook config st -> ThemeName
pluginName Plugin
  AuthURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
authenticatePlugin)
    [hsx|
    <html>
     <head>
      <meta charset="utf-8" />
      <meta http-equiv="X-UA-Compatible" content="IE=edge" />
      <meta name="viewport" content="width=device-width, initial-scale=1.0" />
      -- the meta tags must come first
      <title><% ttl %></title>
      <script src="//code.jquery.com/jquery-latest.js"></script>
      <link rel="stylesheet" type="text/css" media="screen" href=(ThemeData "data/css/bootstrap.min.css")  />
      <script src=(ThemeData "data/js/bootstrap.min.js")></script>
      <link rel="stylesheet" type="text/css" href=(ThemeData "data/css/hscolour.css") />
      <script src="//ajax.googleapis.com/ajax/libs/angularjs/1.2.24/angular.min.js"></script>
      <script src="//ajax.googleapis.com/ajax/libs/angularjs/1.2.24/angular-route.min.js"></script>
      <script src=(JS ClckwrksApp)></script>
      <script src=(authRouteFn (Auth Controllers) [])></script>
      <% hdr %>
      <% googleAnalytics %>
     </head>
     <body ng-app="clckwrksApp" ng-controller="AuthenticationCtrl">
      <div id="wrap">
       <% genNavBar %>
       <div class="container">
         <div class="row">
          <div class="span8">
           <% bdy %>
          </div>
         </div>
       </div>
       <div id="push"></div>
      </div>

      <footer id="footer" class="footer">
       <div class="container">
         <p class="muted">Powered by <a href="http://clckwrks.com/">Clckwrks</a> and <a href="http://happstack.com/">Happstack</a>.</p>
       </div>
      </footer>
     </body>
    </html>
    |]


-- | default `ThemeStyle` for this theme
defaultStyle :: ThemeStyle
defaultStyle :: ThemeStyle
defaultStyle = ThemeStyle :: ThemeName
-> ThemeName
-> Maybe FilePath
-> (forall headers body.
    (EmbedAsChild (Clck ClckURL) headers,
     EmbedAsChild (Clck ClckURL) body) =>
    ThemeName -> headers -> body -> XMLGenT (Clck ClckURL) XML)
-> ThemeStyle
ThemeStyle
    { themeStyleName :: ThemeName
themeStyleName        = ThemeName
"default"
    , themeStyleDescription :: ThemeName
themeStyleDescription = ThemeName
"default view"
    , themeStylePreview :: Maybe FilePath
themeStylePreview     = Maybe FilePath
forall a. Maybe a
Nothing
    , themeStyleTemplate :: forall headers body.
(EmbedAsChild (Clck ClckURL) headers,
 EmbedAsChild (Clck ClckURL) body) =>
ThemeName -> headers -> body -> XMLGenT (Clck ClckURL) XML
themeStyleTemplate    = forall headers body.
(EmbedAsChild (Clck ClckURL) headers,
 EmbedAsChild (Clck ClckURL) body) =>
ThemeName -> headers -> body -> XMLGenT (Clck ClckURL) XML
defaultTemplate
    }