Move Pagination to CSS framework

IHP/Pagination/ViewFunctions.hs

@@ -18,11 +18,13 @@ import IHP.Controller.Param (paramOrNothing)
 import IHP.View.Classes
 import qualified Network.Wai as Wai
 import qualified Network.HTTP.Types.URI as Query
-import IHP.ViewSupport (theRequest)
+import IHP.ViewSupport (theRequest, theCSSFramework)
 import qualified Data.Containers.ListUtils as List
+import IHP.View.Types (PaginationView(..), styledPagination)
+import IHP.View.CSSFramework
 
 
--- | Render a navigation for your pagination. This is to be used in your view whenever 
+-- | Render a navigation for your pagination. This is to be used in your view whenever
 -- to allow users to change pages, including "Next" and "Previous".
 renderPagination :: (?context::ControllerContext) => Pagination -> Html
 renderPagination pagination@Pagination {currentPage, window, pageSize} =
@@ -53,15 +55,23 @@ renderPagination pagination@Pagination {currentPage, window, pageSize} =
                 </div>
             </div>
         </div>
-
     |]
         where
+            paginationView = PaginationView
+                { cssFramework = theCSSFramework
+                , pagination = pagination
+                , previousPageUrl = pageUrl $ currentPage - 1
+                , nextPageUrl = pageUrl $ currentPage + 1
+                }
+
+            renderedHtml = styledPagination theCSSFramework theCSSFramework paginationView
+
             maxItemsGenerator = let
                 oneOption :: Int -> Html
                 oneOption n = [hsx|<option value={show n} selected={n == pageSize} data-url={itemsPerPageUrl n}>{n} items per page</option>|]
                 in
                     [hsx|{forEach [10,20,50,100,200] oneOption}|]
-            
+
             nextClass = classes ["page-item", ("disabled", not $ hasNextPage pagination)]
             prevClass = classes ["page-item", ("disabled", not $ hasPreviousPage pagination)]
 
@@ -198,10 +208,10 @@ setQueryValue name value queryString =
                     )
         Nothing -> queryString <> [(name, Just value)]
 
--- | Removes a query item, specificed by the name
+-- | Removes a query item, specified by the name
 --
 -- >>> removeQueryItem "filter" [("filter", Just "test")]
 -- []
 --
 removeQueryItem :: ByteString -> Query.Query -> Query.Query
-removeQueryItem name queryString = queryString |> filter (\(queryItemName, _) -> queryItemName /= name)
+removeQueryItem name queryString = queryString |> filter (\(queryItemName, _) -> queryItemName /= name)

IHP/View/CSSFramework.hs

@@ -17,6 +17,9 @@ import qualified Text.Blaze.Html5 as H
 import Text.Blaze.Html5 ((!), (!?))
 import qualified Text.Blaze.Html5.Attributes as A
 import IHP.ModelSupport
+import IHP.Pagination.Helpers
+import IHP.Pagination.Types
+
 
 -- | Provides an unstyled CSSFramework
 --
@@ -37,6 +40,7 @@ instance Default CSSFramework where
                 , styledFormGroupClass
                 , styledValidationResult
                 , styledValidationResultClass
+                , styledPagination
             }
         where
             styledFlashMessages cssFramework flashMessages = forEach flashMessages (styledFlashMessage cssFramework cssFramework)
@@ -155,6 +159,45 @@ instance Default CSSFramework where
 
             styledSubmitButtonClass = ""
 
+            styledPagination :: CSSFramework -> PaginationView -> Blaze.Html
+            styledPagination _ paginationView =
+                [hsx| <div>
+                    {liPrevious}
+
+                    <div></div>
+
+                    {liNext}
+
+
+
+                </div>|]
+                where
+                    pagination@Pagination {currentPage} = get #pagination paginationView
+                    previousPageUrl = get #previousPageUrl paginationView
+                    nextPageUrl = get #nextPageUrl paginationView
+                    prevClass = classes ["page-item", ("disabled", not $ hasPreviousPage pagination)]
+                    nextClass = classes ["page-item", ("disabled", not $ hasNextPage pagination)]
+
+                    liPrevious :: Blaze.Html
+                    liPrevious = [hsx|
+                        <li class={prevClass}>
+                            <a class="page-link" href={previousPageUrl} aria-label="Previous">
+                                <span aria-hidden="true">&laquo;</span>
+                                <span class="sr-only">Previous</span>
+                            </a>
+                        </li>
+                    |]
+
+                    liNext = [hsx|
+                        <li class={nextClass}>
+                            <a class="page-link" href={nextPageUrl} aria-label="Previous">
+                                <span aria-hidden="true">&raquo;</span>
+                                <span class="sr-only">Next</span>
+                            </a>
+                        </li>
+                    |]
+
+
 bootstrap :: CSSFramework
 bootstrap = def { styledFlashMessage, styledSubmitButtonClass, styledFormGroupClass, styledFormFieldHelp, styledInputClass, styledInputInvalidClass, styledValidationResultClass }
     where

IHP/View/Types.hs

@@ -11,6 +11,7 @@ module IHP.View.Types
 , FormContext (..)
 , InputType (..)
 , CSSFramework (..)
+, PaginationView(..)
 , HtmlWithContext
 , Layout
 )
@@ -21,6 +22,9 @@ import qualified Text.Blaze.Html5 as Blaze
 import IHP.FlashMessages.Types
 import IHP.ModelSupport (Violation)
 
+-- @todo: Move PaginationView to IHP.Pagination.Types?
+import IHP.Pagination.Types
+
 
 type HtmlWithContext context = (?context :: context) => Blaze.Html
 
@@ -97,6 +101,15 @@ data InputType
     | FileInput
 
 
+-- | Options for customizing the render of a pagination
+data PaginationView =
+    PaginationView
+    { cssFramework :: !CSSFramework
+    , pagination :: !Pagination
+    , previousPageUrl :: !ByteString
+    , nextPageUrl :: !ByteString
+    }
+
 -- | Render functions to render with bootstrap etc.
 --
 -- We call this functions with the cssFramework passed to have late binding (like from OOP languages)
@@ -121,4 +134,6 @@ data CSSFramework = CSSFramework
     , styledValidationResult :: CSSFramework -> FormField -> Blaze.Html
     -- | Class name for container of validation error message
     , styledValidationResultClass :: Text
+    -- | Renders a pager
+    , styledPagination :: CSSFramework -> PaginationView -> Blaze.Html
     }

Main.hs

@@ -22,6 +22,16 @@ instance FrontController RootApplication where
 instance Controller DemoController where
     action DemoAction = renderPlain "Hello World!"
 
+-- @todo: Without this I got an error
+--     * No instance for (Worker RootApplication)
+--        arising from a use of `IHP.Server.run'
+--     * In the expression: IHP.Server.run config
+--       In an equation for `main': main = IHP.Server.run config
+--    |
+-- 31 | main = IHP.Server.run config
+instance Worker RootApplication where
+  workers _ = []
+
 config :: ConfigBuilder
 config = do
     option Development