{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
{-# OPTIONS_GHC -F -pgmFhsx2hs #-}
module Theme where
import Clckwrks
import Clckwrks.Types (NamedLink(..))
import Clckwrks.NavBar.API (getNavBarData)
import Clckwrks.NavBar.Types (NavBar(..), NavBarItem(..))
import Clckwrks.Monad
import Clckwrks.ProfileData.Acid (HasRole(..))
import qualified Data.Set as Set
import Data.Text.Lazy (Text)
import qualified Data.Text as T
import HSP.XMLGenerator
import HSP.XML (XML)
import Paths_clckwrks_theme_clckwrks (getDataDir)
theme :: Theme
theme = Theme
{ themeName = "clckwrks"
, themeStyles = [standardStyle]
, themeDataDir = getDataDir
}
genNavBar :: GenXML (Clck ClckURL)
genNavBar =
do menu <- lift getNavBarData
navBarHTML menu
navBarHTML :: NavBar -> GenXML (Clck ClckURL)
navBarHTML (NavBar menuItems) =
clckwrks
<% mapM mkNavBarItem menuItems %>
mkNavBarItem :: NavBarItem -> GenXML (Clck ClckURL)
mkNavBarItem (NBLink (NamedLink ttl lnk)) =
<% 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 =
<% ttl %>
<% hdr %>
<% googleAnalytics %>
standardStyle :: ThemeStyle
standardStyle = ThemeStyle
{ themeStyleName = "standard"
, themeStyleDescription = "standard view"
, themeStylePreview = Nothing
, themeStyleTemplate = standardTemplate
}