blaze-html-contrib (empty) → 0.1
raw patch · 7 files changed
+239/−0 lines, 7 filesdep +basedep +blaze-htmldep +cgisetup-changed
Dependencies added: base, blaze-html, cgi, data-default, network, pandoc, safe, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- blaze-html-contrib.cabal +27/−0
- src/Data/Pagination.hs +46/−0
- src/Text/Blaze/Extra.hs +53/−0
- src/Text/Blaze/Markdown.hs +20/−0
- src/Text/Blaze/Pagination.hs +61/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Chris Done++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Chris Done nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ blaze-html-contrib.cabal view
@@ -0,0 +1,27 @@+Name: blaze-html-contrib+Version: 0.1+Synopsis: Some contributions to add handy things to blaze html.+Description: Some contributions to add handy things to blaze html. Please+ send your contributions as pull requests to + https://github.com/chrisdone/blaze-html-contrib+Homepage: https://github.com/chrisdone/blaze-html-contrib+License: BSD3+License-file: LICENSE+Author: Chris Done+Maintainer: chrisdone@gmail.com+Copyright: 2011 Chris Done+Category: Web+Build-type: Simple+Cabal-version: >=1.2++Library+ Hs-source-dirs: src+ Exposed-modules: Text.Blaze.Extra, Text.Blaze.Pagination, Text.Blaze.Markdown, Data.Pagination+ Build-depends: base > 4 && < 5,+ network,+ blaze-html,+ safe,+ data-default,+ pandoc,+ text,+ cgi
+ src/Data/Pagination.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE RecordWildCards #-}+-- | Data pagination.++module Data.Pagination where++import Data.Default+import Data.Maybe+import Safe+import Network.URI+import Network.URI.Params++-- | A pagination object, holds information about the name, total, per+-- page, current page, etc.+data Pagination = Pagination+ { pnTotal :: Integer+ , pnPerPage :: Integer+ , pnName :: String+ , pnCurrentPage :: Integer+ , pnShowDesc :: Bool+ } deriving (Show)++instance Default Pagination where+ def = Pagination+ { pnTotal = 0+ , pnPerPage = 5+ , pnName = ""+ , pnCurrentPage = 1+ , pnShowDesc = True+ }++-- | Get the page count of the pagination results.+pnPageCount :: Pagination -> Integer+pnPageCount Pagination{..} = max 1 $+ if total/perpage > fromIntegral (round (total/perpage))+ then round (total/perpage) + 1+ else round (total/perpage)+ where total = fromIntegral pnTotal+ perpage = fromIntegral pnPerPage++-- | Add the current page of the pagination from the current URI.+addCurrentPage :: URI -> Pagination -> Pagination+addCurrentPage uri pagination = pagination { pnCurrentPage = currentPage } where+ currentPage = fromMaybe 1 $ do+ p <- lookup paramName $ uriParams uri+ readMay p+ paramName = pnName pagination ++ "_page"
+ src/Text/Blaze/Extra.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}++module Text.Blaze.Extra where++import Control.Monad+import Data.Monoid+import Prelude hiding (head,div)+import Text.Blaze.Html5 as H hiding (map)+import Text.Blaze.Html5.Attributes as A+import Text.Blaze.Internal (Attributable)+import Network.URI.Params+import Network.URI+import Text.Printf+import Data.List (intercalate)++-- | Add an class to an element.+(!.) :: (Attributable h) => h -> AttributeValue -> h+elem !. className = elem ! class_ className++-- | Add an id to an element.+(!#) :: (Attributable h) => h -> AttributeValue -> h+elem !# idName = elem ! A.id idName++-- | Render a list of lines to HTML.+linesToHtml :: String -> Html+linesToHtml str = forM_ (lines str) $ \line -> do toHtml line; br++-- | Intercalate some HTML.+htmlIntercalate :: Html -> [Html] -> Html+htmlIntercalate _ [x] = x+htmlIntercalate sep (x:xs) = do x; sep; htmlCommas xs+htmlIntercalate _ [] = mempty++-- | Make a list of html into a comma separated html.+htmlCommas :: [Html] -> Html+htmlCommas = htmlIntercalate ", "++-- | Set a parameter of a URI, as an attribute.+hrefSet :: URI -> String -> String -> Attribute+hrefSet uri key value = hrefURI updated where+ updated = updateUrlParam key value uri++-- | Provide a URI as an attribute for href.+hrefURI :: URI -> Attribute+hrefURI uri = href (toValue (showURI uri)) where+ showURI URI{..} = uriPath ++ uriQuery++-- | Create a href from a a path and association list of parameters.+hrefAssoc :: String -> [(String,String)] -> Attribute+hrefAssoc path qs = href (toValue uri) where+ uri = "/" ++ path ++ "?" ++ intercalate "&" (map (uncurry (printf "%s=%s")) qs)
+ src/Text/Blaze/Markdown.hs view
@@ -0,0 +1,20 @@+module Text.Blaze.Markdown where++import Data.Text (pack)+import Text.Blaze.Extra+import Text.Blaze.Html5 as H hiding (map)+import Text.Blaze.Html5.Attributes as A hiding (form,span,cite)+import Text.Pandoc.Parsing+import Text.Pandoc.Readers.Markdown+import Text.Pandoc.Shared+import Text.Pandoc.Writers.HTML++-- | Convert a markdown string to blaze html.+markdownToHtml :: String -> Html+markdownToHtml =+ preEscapedText . pack . markdownToHtmlString++-- | Convert a markdown string to html string.+markdownToHtmlString :: String -> String+markdownToHtmlString =+ writeHtmlString defaultWriterOptions . readMarkdown defaultParserState
+ src/Text/Blaze/Pagination.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-do-bind #-}++-- | Simple pagination support for blaze.++module Text.Blaze.Pagination where++import Control.Monad+import Data.Maybe+import Data.Pagination+import Network.URI+import Network.URI.Params+import qualified Prelude as P+import Prelude hiding (div,span)+import Safe+import Text.Blaze.Extra+import Text.Blaze.Html5 as H hiding (map)+import Text.Blaze.Html5.Attributes as A hiding (form,span,min,max)++-- | Render pagination as html.+pagination :: URI -> Pagination -> Html+pagination uri pn@Pagination{..} =+ div !. "pagination" $ do+ when pnShowDesc description+ chooser+ + where description = do+ span !. "description" $ do+ "Showing "+ toHtml ((pnCurrentPage-1)*pnPerPage + 1)+ "–"+ toHtml (min pnTotal (pnCurrentPage * pnPerPage))+ " of "+ toHtml (pnTotal)+ " results"+ + chooser = do+ div !. "pages" $ do+ ul !. "pages-list" $ do+ when (pnCurrentPage > 1) $+ li !. "page" $ a ! hrefSet uri paramName (show (pnCurrentPage-1)) $+ "Previous"+ let w = 10 :: Integer+ start = max 1 (pnCurrentPage - (w // 2))+ end = min (pageCount) (start + w)+ forM_ [start..end] $ \i ->+ li !. "page" $ do+ let theclass = if i == pnCurrentPage then "current" else ""+ a ! hrefSet uri paramName (show i) !. theclass $+ toHtml (show i)+ when (end < pageCount) $+ li !. "page" $ "…"+ when (pnCurrentPage < pageCount) $+ li !. "page" $ a ! hrefSet uri paramName (show (pnCurrentPage+1)) $+ "Next"+ + paramName = pnName ++ "_page"+ + (//) = P.div+ pageCount = pnPageCount pn