{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-} {-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Theme where import Clckwrks import Clckwrks.NavBar.API (getNavBarData) import Clckwrks.NavBar.Types (NavBar(..), NavBarItem(..)) import Clckwrks.ProfileData.Acid (HasRole(..)) import Data.Maybe (fromMaybe) import qualified Data.Set as Set import Data.Text (Text, unpack) import HSP.XML import HSP.XMLGenerator import Paths_clckwrks_theme_happstack (getDataDir) ------------------------------------------------------------------------------ -- theme ------------------------------------------------------------------------------ theme :: Theme theme = Theme { themeName = "happstack" , themeStyles = [standardStyle] , themeDataDir = getDataDir } ------------------------------------------------------------------------------ -- custom NavBar ------------------------------------------------------------------------------ genNavBar :: GenXML (Clck ClckURL) genNavBar = do menu <- lift getNavBarData navBarHTML menu navBarHTML :: NavBar -> GenXML (Clck ClckURL) navBarHTML (NavBar menuItems) = mkNavBarItem :: NavBarItem -> GenXML (Clck ClckURL) mkNavBarItem (NBLink (NamedLink ttl lnk)) =
  • <% ttl %>
  • ------------------------------------------------------------------------------ -- standard template ------------------------------------------------------------------------------ standardTemplate :: ( EmbedAsChild (ClckT ClckURL (ServerPartT IO)) headers , EmbedAsChild (ClckT ClckURL (ServerPartT IO)) body ) => Text -> headers -> body -> XMLGenT (ClckT ClckURL (ServerPartT IO)) XML standardTemplate ttl hdrs bdy = <% ttl %> <% hdrs %> <% googleAnalytics %>
    <% genNavBar %>
    <% bdy %>
    standardStyle :: ThemeStyle standardStyle = ThemeStyle { themeStyleName = "standard" , themeStyleDescription = "standard view" , themeStylePreview = Nothing , themeStyleTemplate = standardTemplate }