{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings , TypeSynonymInstances , FlexibleInstances , Rank2Types , TemplateHaskell , MultiParamTypeClasses -- ,NoMonomorphismRestriction #-} -- | Themes are used to describe how to render a website/structure -- into HTML module Lykah.Theme2 (theme ,sect ,subSect ,floatingImage ,loremMore ) where import Control.Monad.Identity import qualified Data.Map.Strict as M import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.IO as T import Data.Traversable hiding (sequence) import Lykah.Structure import Lykah.EHtml import Lykah.BuildingBlocks import qualified Lykah.Style as S import Text.BlazeT import qualified Text.BlazeT as B import Text.BlazeT.Html5 hiding (head,link,menu) import qualified Text.BlazeT.Html5 as H import Text.BlazeT.Html5.Attributes hiding (id) import qualified Text.BlazeT.Html5.Attributes as A -- * Static Assets theme :: Theme theme = Theme ([myCss,retina,js,fonts]) t1page bentry menuItem -- TODO: beispiel: einfach pfad geƤndert und alles andere automatisch myCss = Pathed "css/style.css" "myCss" Nothing Nothing $ mconcat [Copy "assets/css/googlefonts.css" ,Write $ T.fromStrict S.myCss ,Copy "assets/css/glyphicons.css" ] fonts = Pathed "fonts" "fonts" Nothing Nothing $ CopyDir "assets/fonts" js = Pathed "main.js" "js" Nothing Nothing $ mconcat [Copy "assets/js.js" ] retina = Pathed "retina.js" "retina" Nothing Nothing $ Copy "assets/retina.min.js" t1page :: SHtml a -- ^ Body -> SHtml a t1page body = do Page t _ _ <- askPage docTypeHtml $ do H.head $ do autoBase meta ! charset "UTF-8" meta ! name "viewport" ! content "width=device-width,initial-scale=1.0" --,maximum-scale=1.0" path' myCss >>= stylesheet' javascript "//code.jquery.com/jquery-1.11.1.min.js" path' js >>= javascript' googleAnalytics =<< readWebsite googleAnalyticsId -- stylesheet "http://fonts.googleapis.com/css?family=Julius+Sans+One%7CMerriweather:300,400,700&subset=latin,latin" reference fonts tit <- readPage pTitle H.title $ string "Dr. Johannes Gerer - " >> tit H.body $ do let mh = H.div $ H.div $ do -- H.div ! class_ ("collapsedExtra hamburger") $ do -- H.span ! class_ "glyphicon glyphicon-menu-hamburger" $ "" a ! class_ "name" $ do H.span ! class_ "long" $ do text "D" H.span ! class_ "letterSpace" $ "r." " Johannes Gerer" H.span ! class_ "short" $ "J. Gerer" menu clear menuExtra "fixedExtra" H.div ! A.id "content" $ do H.div ! class_ "menu" $ do mh ! class_ "visible" mh ! class_ "hidden" clear H.div ! A.id "contentBody" $ do body footer $ sequence_ ["Site proudly generated by " ,link "http://johannesgerer.com/Lykah" "Lykah" ,"."] path' retina >>= javascript' menuExtra :: AttributeValue -> SHtml a menuExtra f = do H.div ! class_ (f <> " title") $ H.span mempty menuItem :: Int -> Bool -- ^ menu item for current page? -> PathedPage () -> SHtml a menuItem ix active p@Pathed{aName=(Just n)} = do -- the following ensures, that the assets is referenced and thus included path <- path' p when active $ do H.span ! class_ "preload glyphicon glyphicon-menu-down" $ "" H.div ! class_ ("collapsedExtra hamburger") $ do H.span ! class_ "glyphicon glyphicon-menu-down" $ "" (! class_' (toValue $ intercalate " " $ [g active, aId p, "menuItem" <> show ix ])) $ a ! href' path ! dataAttribute "text" (toValue n) $ do lazyText n when active $ menuExtra "collapsedExtra" where g True = "active" g False = "inactive" menuItem ix a p = error $ "menuItem not supported for unnamed pages:\n" ++ show (ix, a, p) -- | Blog Entry bentry :: Bool -- ^ full page and not single blog entry -> SHtml Post bentry single = do Page t body (Post dat) <- askPage let d = string $ formatTime defaultTimeLocale "%x %R %Z" (dat ::ZonedTime) H.div ! class_' (postClass "entry" ::String) $ do H.div ! class_ "title" $ do postTitle t H.div ! class_ "date" $ d clear H.div ! class_ "body" $ body clear where (postClass,postTitle) = if single then ((++" single"),id) else (id, \n -> do p <- join $ readPathed path' H.a ! A.href (toValue p) $ n) -- | Section sect :: Monad m => Markup2 -> MarkupT m () -> MarkupT m () -> MarkupT m () sect h t b = H.div ! class_ "section" $ do h ! class_ "title" $ t H.div ! class_ "body" $ b subSect :: Monad m => Markup2 -> MarkupT m () -> MarkupT m () -> MarkupT m () subSect h title body = do h ! class_ "title" $ title body -- | floating image with text, terminated by a clearfix. floatingImage :: IDO a => Int -- ^ size -> Bool -- ^ the image should be wrapped in a link to open it in blank -> String -- ^ classes -> Maybe a -- ^ the image has a downscaled version -> a -- ^ src -> Maybe (EHtml b ()) -- ^ the image should have this description and a clearfix after it -> EHtml b () floatingImage s withLink classes downscaled pId body = H.div ! class_' (intercalate " " ["imgP" ,sc s ,cl body ,classes ]) $ do path <- path' pId let a = if withLink then flip namedLinkB' pId else id path2 <- maybe (return path) path' downscaled a $ img ! src' path2 ! dataAttribute "rjs" (toValue path) fromMaybe mempty body where sc 1 = "small" sc 2 = "normal" sc 0 = "tiny" cl Nothing = "" cl _ = "clearfix"