diff --git a/nix/reflex-platform.json b/nix/reflex-platform.json
index c23c5bf..c4ef65d 100644
--- a/nix/reflex-platform.json
+++ b/nix/reflex-platform.json
@@ -1,7 +1,7 @@
{
"url": "https://github.com/reflex-frp/reflex-platform",
- "rev": "a16213b82f05808ad96b81939850a32ecedd18eb",
+ "rev": "1670c5b899658babeda58329d3df6b943cf6aeca",
"date": "2017-05-05T11:40:26-04:00",
- "sha256": "0dfm8pcpk2zpkfrc9gxh79pkk4ac8ljfm5nqv0sksd64qlhhpj4f",
+ "sha256": "0ry3fcxiqr43c5fghsiqn0iarj4gfvk77jkc4na7j7r3k8vjdjh2",
"fetchSubmodules": true
}
diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
index 981f06e..2e7add2 100644
--- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
+++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
@@ -47,6 +47,8 @@ module Reflex.Dom.Colonnade
, headedResizable
-- * Other Stuff
, defBureau
+ -- * Pagination
+ , semUiFixedPagination
) where
import Data.String (IsString(..))
@@ -68,6 +70,7 @@ import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..))
import Data.Monoid (Sum(..))
import Data.Proxy
import Control.Monad.Fix (MonadFix)
+import Control.Monad (forM)
import qualified Colonnade as C
import qualified Colonnade.Encode as E
@@ -94,6 +97,20 @@ data Bureau t h a = Bureau
}
-- , bureauHeadRow :: h (Dynamic t (Map Text Text))
+data Pagination t m = Pagination
+ { paginationRows :: Int
+ -- ^ Maximum number of rows on a page
+ , paginationArrangement :: Arrangement t
+ -- ^ Where pagination is situated relative to table
+ , paginationContent :: Dynamic t Int -> m (Dynamic t Int)
+ -- ^ The argument to this function is an @Dynamic@ that carries
+ -- the total number of pages that should be available. When
+ -- this dynamic changes, it means that the rows backing the
+ -- table have been changed. Typically, this should cause
+ -- the @Dynamic@ in the return value to reset to 0. This
+ -- returned @Dynamic@ represents the current page.
+ }
+
-- | Where the pagination goes relative to the table
data Arrangement t
= ArrangementAbove
@@ -104,14 +121,6 @@ data Arrangement t
(Dynamic t (Map Text Text))
-- ^ contains attributes of @\
@, its inner @\@, and its inner @\| @.
--- | The argument to this function is an @Dynamic@ that carries
--- the total number of pages that should be available. When
--- this dynamic changes, it means that the rows backing the
--- table have been changed. Typically, this should cause
--- the @Dynamic@ in the return value to reset to 0. This
--- returned @Dynamic@ represents the current page.
-newtype Pagination t m = Pagination { runPagination :: Dynamic t Int -> m (Dynamic t Int) }
-
class (PostBuild t m, DomBuilder t m) => Cellular t m c | c -> m, c -> t where
cellularAttrs :: c b -> Dynamic t (Map Text Text)
cellularContents :: c b -> m b
@@ -563,18 +572,15 @@ data Visible a = Visible !Bool a
paginated :: forall t b h m a c.
(Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h)
- => Bureau t b a
- -> Arrangement t
- -> Pagination t m
- -> Int -- ^ number of records on a page
+ => Bureau t b a -- ^ table class settings
+ -> Pagination t m -- ^ pagination settings
-> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows.
- -> Colonnade h (Dynamic t a) (c ())
- -> Dynamic t (Vector a)
+ -> Colonnade h (Dynamic t a) (c ()) -- ^ column blueprint
+ -> Dynamic t (Vector a) -- ^ table row data
-> m ()
-paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) arrange (Pagination makePagination) pageSize aDef col vecD = do
+paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize arrange makePagination) aDef col vecD = do
let colLifted :: Colonnade h (Dynamic t (Visible a)) (c ())
colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col
- -- colLifted = E.Colonnade (V.map (\(E.OneColonnade h f) -> E.OneColonnade h (\x -> maybe nothingContents f)) (E.getColonnade col))
makeVals :: Dynamic t Int -> Vector (Dynamic t (Visible a))
makeVals page = V.generate pageSize $ \ix -> do
p <- page
@@ -587,14 +593,20 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) arrange (Pagination m
Visible isVisible a <- d
attrs <- trAttrs a
return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
+ size :: Dynamic t Int
+ size = coerceDynamic (foldMap (\x -> coerceDynamic (sizableSize (E.oneColonnadeHead x)) :: Dynamic t (Sum Int)) (E.getColonnade col))
elDynAttr "table" tableAttrs $ case arrange of
ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
+ let tfootAttrsExtra = zipDynWith
+ ( \sz attrs -> if sz > 0 then attrs else M.insert "style" "display:none;" attrs
+ ) size tfootAttrs
tableHeader theadAttrs colLifted
let vals = makeVals page
tableBody bodyAttrs trAttrsLifted colLifted vals
- page <- elDynAttr "tfoot" tfootAttrs $ do
+ page <- elDynAttr "tfoot" tfootAttrsExtra $ do
elDynAttr "tr" tfootTrAttrs $ do
- elDynAttr "th" tfootThAttrs $ do
+ let attrs = zipDynWith insertSizeAttr size tfootThAttrs
+ elDynAttr "th" attrs $ do
makePagination totalPages
return ()
_ -> error "Reflex.Dom.Colonnade: paginated: write this code"
@@ -657,5 +669,41 @@ insertSizeAttr i m
| i < 1 = M.insertWith T.append "style" "display:none;" m
| otherwise = M.insert "colspan" (T.pack (show i)) m
+-- | only used internally for implementations of 'Pagination'.
+data Movement = Forward | Backward | Position !Int
-
+-- | Pagination using the classes and DOM layout that Semantic UI
+-- expects. The function will typically be partially applided
+-- to the first two arguments to make it suitable as a field
+-- of 'Pagination'.
+semUiFixedPagination :: MonadWidget t m
+ => Int -- ^ Maximum allowed number of pages.
+ -> Text -- ^ Extra classes to be applied. Already included is @ui pagination menu@.
+ -> Dynamic t Int
+ -> m (Dynamic t Int)
+semUiFixedPagination maxPageCount extraClass pageCount = do
+ elClass "div" (T.append "ui pagination menu " extraClass) $ mdo
+ (bckEl,()) <- elClass' "a" "icon item" $ do
+ elClass "i" "left chevron icon" (return ())
+ let bck = Backward <$ domEvent Click bckEl
+ posList <- forM (enumFromTo 0 (maxPageCount - 1)) $ \i -> do
+ let attrs = zipDynWith (\ct pg -> M.unionsWith (<>)
+ [ if i < ct then M.empty else M.singleton "style" "display:none;"
+ , if i == pg then M.singleton "class" " active " else M.empty
+ , M.singleton "class" " item "
+ ]
+ ) pageCount page
+ (pageEl, ()) <- elDynAttr' "a" attrs (text (T.pack (show i)))
+ return (Position i <$ domEvent Click pageEl)
+ (fwdEl,()) <- elClass' "a" "icon item" $ do
+ elClass "i" "right chevron icon" (return ())
+ let fwd = Forward <$ domEvent Click fwdEl
+ let moveEv = leftmost (fwd : bck : posList)
+ page <- foldDynM (\move oldPage -> case move of
+ Backward -> return (max 0 (oldPage - 1))
+ Forward -> do
+ nowPageCount <- sample (current pageCount)
+ return (min (nowPageCount - 1) (oldPage + 1))
+ Position updatedPage -> return updatedPage
+ ) 0 moveEv
+ holdUniqDyn page
|