1 {-# LANGUAGE OverloadedStrings #-} 2 module View.Paginate 3 ( htmlPaginate 4 ) where 5 6 import Control.Arrow (first) 7 import Control.Monad (forM_) 8 import qualified Data.ByteString.Char8 as BSC 9 import Data.Int (Int32) 10 import Data.Maybe (catMaybes) 11 import qualified Network.Wai as Wai 12 import qualified Text.Blaze.Html5 as H 13 import qualified Text.Blaze.Html5.Attributes as HA 14 15 import Ops 16 import Model.Paginate 17 import HTTP (encodePath') 18 import View.Html 19 20 take' :: Int32 -> [a] -> ([a], Bool) 21 take' _ [] = ([], False) 22 take' 0 _ = ([], True) 23 take' n (x:l) = first (x:) $ take' (pred n) l 24 25 paginateContent :: Paginate -> [a] -> (Maybe Paginate, [a], Maybe Paginate) 26 paginateContent (Paginate o l) x = ((o > 0) `thenUse` Paginate (o-l' `max` 0) l, x', m `thenUse` Paginate (o+l') l) 27 where 28 l' = pred l 29 (x', m) = take' l' x 30 31 paginateLink :: Paginate -> Wai.Request -> H.Attribute 32 paginateLink (Paginate o l) q = HA.href $ builderValue $ encodePath' (Wai.pathInfo q) $ 33 filter ((`notElem` ["offset", "limit"]) . fst) (Wai.queryString q) ++ catMaybes 34 [ (o == paginateOffset def) `unlessUse` ("offset", Just $ BSC.pack $ show o) 35 , (l == paginateLimit def) `unlessUse` ("limit", Just $ BSC.pack $ show l) 36 ] 37 38 htmlPaginate :: ([a] -> H.Html) -> Paginate -> [a] -> Wai.Request -> H.Html 39 htmlPaginate f p c q = do 40 f c' 41 H.ul 42 H.! HA.class_ "search-pages" 43 $ do 44 forM_ prev (\p' -> H.li $ H.a H.! paginateLink p' q $ "prev") 45 forM_ next (\p' -> H.li $ H.a H.! paginateLink p' q $ "next") 46 where (prev, c', next) = paginateContent p c