{-# OPTIONS -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | HTML-specific view functions. module Hpaste.View.Html (aClass ,aClasses ,darkSection ,darkNoTitleSection ,lightSection ,lightNoTitleSection ,warnNoTitleSection ,errorNoTitleSection ,href ,clear ,showLanguage ,showChannel ,paginate ,preEscapedString) where import Hpaste.Types import Control.Arrow ((&&&)) import Control.Monad (when) import Data.Maybe (fromMaybe) import Data.Monoid.Operator ((++)) import Data.Pagination import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as T import Network.URI.Params import Network.URI import Prelude hiding ((++)) import Text.Blaze.Html5 as H hiding (map,nav) import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Extra import Snap.App.Types -- | A class prefixed with amelie-. aClass :: AttributeValue -> Attribute aClass name = A.class_ ("amelie-" ++ name) -- | A class prefixed with amelie-. aClasses :: [Text] -> Attribute aClasses names = A.class_ $ toValue $ T.intercalate " " $ map ("amelie-" ++) names -- | A warning section. warnNoTitleSection :: Markup -> Markup warnNoTitleSection inner = H.div ! aClasses ["section","section-warn"] $ do inner -- | An error section. errorNoTitleSection :: Markup -> Markup errorNoTitleSection inner = H.div ! aClasses ["section","section-error"] $ do inner -- | A dark section. darkSection :: Text -> Markup -> Markup darkSection title inner = H.div ! aClasses ["section","section-dark"] $ do h2 $ toMarkup title inner -- | A dark section. darkNoTitleSection :: Markup -> Markup darkNoTitleSection inner = H.div ! aClasses ["section","section-dark"] $ do inner -- | A light section. lightSection :: Text -> Markup -> Markup lightSection title inner = H.div ! aClasses ["section","section-light"] $ do h2 $ toMarkup title inner -- | A light section with no title. lightNoTitleSection :: Markup -> Markup lightNoTitleSection inner = H.div ! aClasses ["section","section-light"] $ do inner -- | An anchor link. href :: (ToValue location,ToMarkup html) => location -> html -> Markup href loc content = H.a ! A.href (toValue loc) $ toMarkup content -- | A clear:both element. clear :: Markup clear = H.div ! aClass "clear" $ return () -- | Show a language. showLanguage :: [Language] -> Maybe LanguageId -> Markup showLanguage languages lid = toMarkup $ fromMaybe "-" (lid >>= (`lookup` langs)) where langs = map (languageId &&& languageTitle) languages -- | Show a channel. showChannel :: Maybe Paste -> [Channel] -> Maybe ChannelId -> Markup showChannel paste channels lid = do toMarkup $ fromMaybe "-" chan case (paste,chan) of (Just paste,Just c) | c == "#haskell" -> do " " href ("http://ircbrowse.net/browse/haskell/?q=hpaste+" ++ show (pasteId paste)) $ ("Context in IRC logs" :: String) _ -> return () where langs = map (channelId &&& channelName) channels chan = (lid >>= (`lookup` langs)) -- | Render results with pagination. paginate :: URI -> Pagination -> Markup -> Markup paginate uri pn inner = do nav uri pn True inner nav uri pn False -- | Show a pagination navigation, with results count, if requested. nav :: URI -> Pagination -> Bool -> Markup nav uri pn@Pagination{..} showTotal = do H.div ! aClass "pagination" $ do H.div ! aClass "inner" $ do when (pnCurrentPage-1 > 0) $ navDirection uri pn (-1) "Previous" toMarkup (" " :: Text) when (pnTotal == pnPerPage) $ navDirection uri pn 1 "Next" when showTotal $ do br toMarkup $ results where results = unwords [show start ++ "—" ++ show end ,"results of" ,show pnTotal] start = 1 + (pnCurrentPage - 1) * pnTotal end = pnCurrentPage * pnTotal -- | Link to change navigation page based on a direction. navDirection :: URI -> Pagination -> Integer -> Text -> Markup navDirection uri Pagination{..} change caption = do a ! hrefURI uri $ toMarkup caption where uri = updateUrlParam "page" (show (pnCurrentPage + change)) uri -- | Migration function. preEscapedString :: String -> Markup preEscapedString = preEscapedToMarkup