1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.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 Databrary.Ops
   16 import Databrary.Model.Paginate
   17 import Databrary.HTTP (encodePath')
   18 import Databrary.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