{-# 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 Clckwrks.ProfileData.Acid (HasRole(..)) import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Data.Text.Lazy (Text) import qualified Data.Text as T import Happstack.Authenticate.Password.URL (PasswordURL(UsernamePasswordCtrl), passwordAuthenticationMethod) import HSP.XMLGenerator import HSP.XML (XML) import Language.Haskell.HSX.QQ (hsx) import Paths_clckwrks_theme_clckwrks (getDataDir) import Web.Plugins.Core (pluginName, getPluginRouteFn) theme :: Theme theme = Theme { themeName = "clckwrks" , themeStyles = [standardStyle] , themeDataDir = getDataDir } -- | function te generate the navigation bar genNavBar :: GenXML (Clck ClckURL) genNavBar = do menu <- lift getNavBarData mName <- query GetSiteName navBarHTML (fromMaybe "clckwrks" mName) menu -- | helper function to generate a navigation bar from the navigation bar data navBarHTML :: T.Text -- ^ brand -> NavBar -- ^ navigation bar links -> GenXML (Clck ClckURL) navBarHTML brand (NavBar menuItems) = [hsx| |] mkNavBarItem :: NavBarItem -> GenXML (Clck ClckURL) mkNavBarItem (NBLink (NamedLink ttl lnk)) = [hsx|
  • <% ttl %>
    • |] standardTemplate :: ( EmbedAsChild (ClckT ClckURL (ServerPartT IO)) headers , EmbedAsChild (ClckT ClckURL (ServerPartT IO)) body ) => T.Text -> headers -> body -> XMLGenT (ClckT ClckURL (ServerPartT IO)) XML standardTemplate ttl hdr bdy = do p <- plugins <$> get (Just authRouteFn) <- getPluginRouteFn p (pluginName authenticatePlugin) [hsx| -- the meta tags must come first <% ttl %> -- jquery -- bootstrap -- angular <% hdr %> <% googleAnalytics %>
    <% genNavBar %>
    <% bdy %>
    |] standardStyle :: ThemeStyle standardStyle = ThemeStyle { themeStyleName = "standard" , themeStyleDescription = "standard view" , themeStylePreview = Nothing , themeStyleTemplate = standardTemplate }