diff --git a/blaze-colonnade/blaze-colonnade.cabal b/blaze-colonnade/blaze-colonnade.cabal
index d1844c4..2602abf 100644
--- a/blaze-colonnade/blaze-colonnade.cabal
+++ b/blaze-colonnade/blaze-colonnade.cabal
@@ -1,5 +1,5 @@
name: blaze-colonnade
-version: 1.1.0
+version: 1.1.1
synopsis: Helper functions for using blaze-html with colonnade
description: Blaze HTML and colonnade
homepage: https://github.com/andrewthad/colonnade#readme
@@ -18,7 +18,7 @@ library
Text.Blaze.Colonnade
build-depends:
base >= 4.7 && < 5
- , colonnade >= 1.1 && < 1.2
+ , colonnade >= 1.1 && < 1.3
, blaze-markup >= 0.7 && < 0.9
, blaze-html >= 0.8 && < 0.10
, text >= 1.0 && < 1.3
diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal
index 6fdf14e..2f014c2 100644
--- a/colonnade/colonnade.cabal
+++ b/colonnade/colonnade.cabal
@@ -1,5 +1,5 @@
name: colonnade
-version: 1.1.1
+version: 1.2.0
synopsis: Generic types and functions for columnar encoding and decoding
description:
The `colonnade` package provides a way to to talk about
diff --git a/colonnade/src/Colonnade/Encode.hs b/colonnade/src/Colonnade/Encode.hs
index c8c7e10..bd85958 100644
--- a/colonnade/src/Colonnade/Encode.hs
+++ b/colonnade/src/Colonnade/Encode.hs
@@ -285,22 +285,22 @@ endow f x = case x of
go c (CorniceBase (Colonnade v)) = V.map (mapOneColonnadeHeader (f c)) v
go c (CorniceCap v) = V.concatMap (\(OneCornice h b) -> go (f c h) b) v
-uncapAnnotated :: forall sz p a c.
- AnnotatedCornice sz p a c
- -> Colonnade (Sized sz Headed) a c
+uncapAnnotated :: forall sz p a c h.
+ AnnotatedCornice sz h p a c
+ -> Colonnade (Sized sz h) a c
uncapAnnotated x = case x of
AnnotatedCorniceBase _ colonnade -> colonnade
AnnotatedCorniceCap _ v -> Colonnade (V.concatMap (\(OneCornice _ b) -> go b) v)
where
go :: forall p'.
- AnnotatedCornice sz p' a c
- -> Vector (OneColonnade (Sized sz Headed) a c)
+ AnnotatedCornice sz h p' a c
+ -> Vector (OneColonnade (Sized sz h) a c)
go (AnnotatedCorniceBase _ (Colonnade v)) = v
go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v
-annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) p a c
+annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c
annotate = go where
- go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) p a c
+ go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) Headed p a c
go (CorniceBase c) = let len = V.length (getColonnade c) in
AnnotatedCorniceBase
(if len > 0 then (Just len) else Nothing)
@@ -333,7 +333,7 @@ annotateFinely :: Foldable f
-> (c -> Int) -- ^ Get size from content
-> f a
-> Cornice Headed p a c
- -> AnnotatedCornice (Maybe Int) p a c
+ -> AnnotatedCornice (Maybe Int) Headed p a c
annotateFinely g finish toSize xs cornice = runST $ do
m <- newMutableSizedCornice cornice
sizeColonnades toSize xs m
@@ -360,12 +360,12 @@ freezeMutableSizedCornice :: forall s p a c.
(Int -> Int -> Int) -- ^ fold function
-> (Int -> Int) -- ^ finalize
-> MutableSizedCornice s p a c
- -> ST s (AnnotatedCornice (Maybe Int) p a c)
+ -> ST s (AnnotatedCornice (Maybe Int) Headed p a c)
freezeMutableSizedCornice step finish = go
where
go :: forall p' a' c'.
MutableSizedCornice s p' a' c'
- -> ST s (AnnotatedCornice (Maybe Int) p' a' c')
+ -> ST s (AnnotatedCornice (Maybe Int) Headed p' a' c')
go (MutableSizedCorniceBase msc) = do
szCol <- freezeMutableSizedColonnade msc
let sz =
@@ -400,7 +400,7 @@ mapHeadedness f (Colonnade v) =
-- | This is an O(1) operation, sort of
-size :: AnnotatedCornice sz p a c -> sz
+size :: AnnotatedCornice sz h p a c -> sz
size x = case x of
AnnotatedCorniceBase m _ -> m
AnnotatedCorniceCap sz _ -> sz
@@ -411,23 +411,25 @@ mapOneCorniceBody f (OneCornice h b) = OneCornice h (f b)
mapOneColonnadeHeader :: Functor h => (c -> c) -> OneColonnade h a c -> OneColonnade h a c
mapOneColonnadeHeader f (OneColonnade h b) = OneColonnade (fmap f h) b
-headersMonoidal :: forall sz r m c p a.
- Monoid m
+headersMonoidal :: forall sz r m c p a h.
+ (Monoid m, Headedness h)
=> Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content
-> [(sz -> c -> m, m -> m)] -- ^ Build content from cell content and size
- -> AnnotatedCornice sz p a c
+ -> AnnotatedCornice sz h p a c
-> m
headersMonoidal wrapRow fromContentList = go wrapRow
where
- go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice sz p' a c -> m
+ go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice sz h p' a c -> m
go ef (AnnotatedCorniceBase _ (Colonnade v)) =
let g :: m -> m
g m = case ef of
Nothing -> m
Just (FasciaBase r, f) -> f r m
- in g $ foldMap (\(fromContent,wrap) -> wrap
- (foldMap (\(OneColonnade (Sized sz (Headed h)) _) ->
- (fromContent sz h)) v)) fromContentList
+ in case headednessExtract of
+ Just unhead -> g $ foldMap (\(fromContent,wrap) -> wrap
+ (foldMap (\(OneColonnade (Sized sz h) _) ->
+ (fromContent sz (unhead h))) v)) fromContentList
+ Nothing -> mempty
go ef (AnnotatedCorniceCap _ v) =
let g :: m -> m
g m = case ef of
@@ -444,8 +446,8 @@ headersMonoidal wrapRow fromContentList = go wrapRow
Just annCoreNext -> go (Just (fn,f)) annCoreNext
flattenAnnotated ::
- Vector (OneCornice (AnnotatedCornice sz) p a c)
- -> Maybe (AnnotatedCornice sz p a c)
+ Vector (OneCornice (AnnotatedCornice sz h) p a c)
+ -> Maybe (AnnotatedCornice sz h p a c)
flattenAnnotated v = case v V.!? 0 of
Nothing -> Nothing
Just (OneCornice _ x) -> Just $ case x of
@@ -454,8 +456,8 @@ flattenAnnotated v = case v V.!? 0 of
flattenAnnotatedBase ::
sz
- -> Vector (OneCornice (AnnotatedCornice sz) Base a c)
- -> AnnotatedCornice sz Base a c
+ -> Vector (OneCornice (AnnotatedCornice sz h) Base a c)
+ -> AnnotatedCornice sz h Base a c
flattenAnnotatedBase msz = AnnotatedCorniceBase msz
. Colonnade
. V.concatMap
@@ -463,13 +465,13 @@ flattenAnnotatedBase msz = AnnotatedCorniceBase msz
flattenAnnotatedCap ::
sz
- -> Vector (OneCornice (AnnotatedCornice sz) (Cap p) a c)
- -> AnnotatedCornice sz (Cap p) a c
+ -> Vector (OneCornice (AnnotatedCornice sz h) (Cap p) a c)
+ -> AnnotatedCornice sz h (Cap p) a c
flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector
getTheVector ::
- OneCornice (AnnotatedCornice sz) (Cap p) a c
- -> Vector (OneCornice (AnnotatedCornice sz) p a c)
+ OneCornice (AnnotatedCornice sz h) (Cap p) a c
+ -> Vector (OneCornice (AnnotatedCornice sz h) p a c)
getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v
data MutableSizedCornice s (p :: Pillar) a c where
@@ -594,12 +596,23 @@ data Fascia (p :: Pillar) r where
data OneCornice k (p :: Pillar) a c = OneCornice
{ oneCorniceHead :: !c
, oneCorniceBody :: !(k p a c)
- }
+ } deriving (Functor)
data Cornice h (p :: Pillar) a c where
CorniceBase :: !(Colonnade h a c) -> Cornice h Base a c
CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice (Cornice h) p a c)) -> Cornice h (Cap p) a c
+instance Functor h => Functor (Cornice h p a) where
+ fmap f x = case x of
+ CorniceBase c -> CorniceBase (fmap f c)
+ CorniceCap c -> CorniceCap (mapVectorCornice f c)
+
+instance Functor h => Profunctor (Cornice h p) where
+ rmap = fmap
+ lmap f x = case x of
+ CorniceBase c -> CorniceBase (lmap f c)
+ CorniceCap c -> CorniceCap (contramapVectorCornice f c)
+
instance Semigroup (Cornice h p a c) where
CorniceBase a <> CorniceBase b = CorniceBase (mappend a b)
CorniceCap a <> CorniceCap b = CorniceCap (a Vector.++ b)
@@ -614,21 +627,30 @@ instance ToEmptyCornice p => Monoid (Cornice h p a c) where
[] -> toEmptyCornice
x : xs2 -> Semigroup.sconcat (x :| xs2)
+mapVectorCornice :: Functor h => (c -> d) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p a d)
+mapVectorCornice f = V.map (fmap f)
+
+contramapVectorCornice :: Functor h => (b -> a) -> Vector (OneCornice (Cornice h) p a c) -> Vector (OneCornice (Cornice h) p b c)
+contramapVectorCornice f = V.map (lmapOneCornice f)
+
+lmapOneCornice :: Functor h => (b -> a) -> OneCornice (Cornice h) p a c -> OneCornice (Cornice h) p b c
+lmapOneCornice f (OneCornice theHead theBody) = OneCornice theHead (lmap f theBody)
+
getCorniceBase :: Cornice h Base a c -> Colonnade h a c
getCorniceBase (CorniceBase c) = c
getCorniceCap :: Cornice h (Cap p) a c -> Vector (OneCornice (Cornice h) p a c)
getCorniceCap (CorniceCap c) = c
-data AnnotatedCornice sz (p :: Pillar) a c where
+data AnnotatedCornice sz h (p :: Pillar) a c where
AnnotatedCorniceBase ::
!sz
- -> !(Colonnade (Sized sz Headed) a c)
- -> AnnotatedCornice sz Base a c
+ -> !(Colonnade (Sized sz h) a c)
+ -> AnnotatedCornice sz h Base a c
AnnotatedCorniceCap ::
!sz
- -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz) p a c))
- -> AnnotatedCornice sz (Cap p) a c
+ -> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz h) p a c))
+ -> AnnotatedCornice sz h (Cap p) a c
-- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt
diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal
index bb94fe8..92f3efe 100644
--- a/reflex-dom-colonnade/reflex-dom-colonnade.cabal
+++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal
@@ -18,7 +18,7 @@ library
Reflex.Dom.Colonnade
build-depends:
base >= 4.7 && < 5.0
- , colonnade >= 1.1 && < 1.2
+ , colonnade >= 1.2 && < 1.3
, contravariant >= 1.2 && < 1.5
, vector >= 0.10 && < 0.13
, text >= 1.0 && < 1.3
diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
index 5bd3ba2..e9479ba 100644
--- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
+++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs
@@ -21,6 +21,7 @@ module Reflex.Dom.Colonnade
Cell(..)
, Resizable(..)
, Bureau(..)
+ , Chest(..)
, Arrangement(..)
, Pagination(..)
-- * Typeclasses
@@ -40,6 +41,7 @@ module Reflex.Dom.Colonnade
, sectioned
, paginated
, paginatedExpandable
+ , paginatedCapped
-- * Cell Functions
, cell
, charCell
@@ -99,7 +101,14 @@ data Bureau t h a = Bureau
, bureauRow :: (a -> Dynamic t (Map Text Text))
-- ^ attributes of each @\
@, based on the element
}
- -- , bureauHeadRow :: h (Dynamic t (Map Text Text))
+
+data Chest p t a = Chest
+ { chestTable :: Dynamic t (Map Text Text)
+ , chestHead :: Dynamic t (Map Text Text)
+ , chestFascia :: Fascia p (Map Text Text)
+ , chestBody :: Dynamic t (Map Text Text)
+ , chestRow :: (a -> Dynamic t (Map Text Text))
+ }
data Pagination t m = Pagination
{ paginationRows :: Int
@@ -266,18 +275,20 @@ bodyRows trAttrs colonnade collection =
unWrappedApplicative $
E.rowMonoidal colonnade (WrappedApplicative . elFromCell "td") a
-bodyResizable :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
- => Map Text Text
- -> (a -> Map Text Text)
- -> Colonnade (Resizable t h) a (Cell t m e)
+bodyResizable :: (Cellular t m c, DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
+ => Dynamic t (Map Text Text)
+ -> (a -> Dynamic t (Map Text Text))
+ -> Colonnade (Resizable t h) a (c e)
-> f a
-> m e
-bodyResizable bodyAttrs trAttrs colonnade collection = elAttr "tbody" bodyAttrs $ do
+bodyResizable bodyAttrs trAttrs colonnade collection = elDynAttr "tbody" bodyAttrs $ do
unWrappedApplicative . flip foldMap collection $ \a -> WrappedApplicative
- $ elAttr "tr" (trAttrs a)
+ $ elDynAttr "tr" (trAttrs a)
$ unWrappedApplicative
- $ E.rowMonoidalHeader colonnade (\(Resizable dynSize _) (Cell cattr content) ->
- WrappedApplicative (elDynAttr "td" (zipDynWith setColspanOrHide dynSize cattr) content)) a
+ $ E.rowMonoidalHeader colonnade (\(Resizable dynSize _) c ->
+ let cattr = cellularAttrs c
+ content = cellularContents c
+ in WrappedApplicative (elDynAttr "td" (zipDynWith setColspanOrHide dynSize cattr) content)) a
setColspanOrHide :: Int -> Map Text Text -> Map Text Text
setColspanOrHide i m
@@ -345,7 +356,7 @@ encodeCorniceHead ::
(DomBuilder t m, PostBuild t m, Monoid e)
=> M.Map T.Text T.Text
-> Fascia p (M.Map T.Text T.Text)
- -> E.AnnotatedCornice (Maybe Int) p a (Cell t m e)
+ -> E.AnnotatedCornice (Maybe Int) Headed p a (Cell t m e)
-> m e
encodeCorniceHead headAttrs fascia annCornice =
elAttr "thead" headAttrs (unWrappedApplicative thead)
@@ -358,7 +369,7 @@ encodeCorniceResizableHead :: forall t m e p a.
(DomBuilder t m, PostBuild t m, Monoid e)
=> M.Map T.Text T.Text
-> Fascia p (M.Map T.Text T.Text)
- -> E.AnnotatedCornice (Dynamic t Int) p a (Cell t m e)
+ -> E.AnnotatedCornice (Dynamic t Int) Headed p a (Cell t m e)
-> m e
encodeCorniceResizableHead headAttrs fascia annCornice =
elAttr "thead" headAttrs (unWrappedApplicative thead)
@@ -370,6 +381,22 @@ encodeCorniceResizableHead headAttrs fascia annCornice =
addAttr :: Map Text Text -> WrappedApplicative m b -> WrappedApplicative m b
addAttr attrs = WrappedApplicative . elAttr "tr" attrs . unWrappedApplicative
+encodeCorniceHeadGeneral :: forall t m e p a b c.
+ (DomBuilder t m, PostBuild t m, Monoid e, Headedness b, Cellular t m c)
+ => Dynamic t (M.Map T.Text T.Text)
+ -> Fascia p (M.Map T.Text T.Text)
+ -> E.AnnotatedCornice (Dynamic t Int) b p a (c e)
+ -> m e
+encodeCorniceHeadGeneral headAttrs fascia annCornice =
+ elDynAttr "thead" headAttrs (unWrappedApplicative thead)
+ where
+ thead :: WrappedApplicative m e
+ thead = E.headersMonoidal (Just (fascia, addAttr)) [(th,id)] annCornice
+ th :: Dynamic t Int -> c e -> WrappedApplicative m e
+ th size c = WrappedApplicative (elDynAttr "th" (zipDynWith setColspanOrHide size (cellularAttrs c)) (cellularContents c))
+ addAttr :: Map Text Text -> WrappedApplicative m r -> WrappedApplicative m r
+ addAttr attrs = WrappedApplicative . elAttr "tr" attrs . unWrappedApplicative
+
capped ::
(DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e)
=> M.Map T.Text T.Text -- ^ @\@ tag attributes
@@ -407,7 +434,7 @@ cappedResizable tableAttrs headAttrs bodyAttrs beneathBody trAttrs fascia cornic
elAttr "table" tableAttrs $ do
let annCornice = dynamicAnnotate cornice
h <- encodeCorniceResizableHead headAttrs fascia annCornice
- b <- bodyResizable bodyAttrs trAttrs (E.discard cornice) collection
+ b <- bodyResizable (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
c <- beneathBody
return (h `mappend` b, c, E.size annCornice)
@@ -425,16 +452,36 @@ cappedResizableTableless ::
cappedResizableTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do
let annCornice = dynamicAnnotate cornice
h <- encodeCorniceResizableHead headAttrs fascia annCornice
- b <- bodyResizable bodyAttrs trAttrs (E.discard cornice) collection
+ b <- bodyResizable (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
return (h `mappend` b, E.size annCornice)
+cappedTableless ::
+ (Headedness b, Sizable t b h, DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e, Cellular t m c)
+ => Dynamic t (Map Text Text) -- ^ @\@ tag attributes
+ -> Dynamic t (Map Text Text) -- ^ @\@ tag attributes
+ -> (a -> Dynamic t (Map Text Text)) -- ^ @\@ tag attributes
+ -> Fascia p (Map Text Text) -- ^ Attributes for @\
@ elements in the @\@
+ -> Cornice h p a (c e) -- ^ Data encoding strategy
+ -> f a -- ^ Collection of data
+ -> m (e, Dynamic t Int)
+cappedTableless headAttrs bodyAttrs trAttrs fascia cornice collection = do
+ let annCornice = dynamicAnnotateGeneral cornice
+ h <- encodeCorniceHeadGeneral headAttrs fascia annCornice
+ b <- bodyResizable bodyAttrs trAttrs
+ (C.mapHeadedness sizedToResizable (E.uncapAnnotated annCornice))
+ collection
+ return (h `mappend` b, E.size annCornice)
+
+sizedToResizable :: E.Sized (Dynamic t Int) h a -> Resizable t h a
+sizedToResizable (E.Sized sz h) = Resizable sz h
+
dynamicAnnotate :: Reflex t
=> Cornice (Resizable t Headed) p a c
- -> E.AnnotatedCornice (Dynamic t Int) p a c
+ -> E.AnnotatedCornice (Dynamic t Int) Headed p a c
dynamicAnnotate = go where
go :: forall t p a c. Reflex t
=> Cornice (Resizable t Headed) p a c
- -> E.AnnotatedCornice (Dynamic t Int) p a c
+ -> E.AnnotatedCornice (Dynamic t Int) Headed p a c
go (E.CorniceBase c@(E.Colonnade cs)) =
let parentSz :: Dynamic t (Sum Int)
parentSz = foldMap (\(E.OneColonnade (Resizable sz _) _) -> (coerceDynamic sz :: Dynamic t (Sum Int))) cs
@@ -445,6 +492,24 @@ dynamicAnnotate = go where
parentSz = foldMap (\(E.OneCornice _ theBody) -> (coerceDynamic (E.size theBody) :: Dynamic t (Sum Int))) annChildren
in E.AnnotatedCorniceCap (coerceDynamic parentSz) annChildren
+-- | Like dynamicAnnotate but more general.
+dynamicAnnotateGeneral :: (Reflex t, Sizable t b h)
+ => Cornice h p a c
+ -> E.AnnotatedCornice (Dynamic t Int) b p a c
+dynamicAnnotateGeneral = go where
+ go :: forall t p a c b h. (Reflex t, Sizable t b h)
+ => Cornice h p a c
+ -> E.AnnotatedCornice (Dynamic t Int) b p a c
+ go (E.CorniceBase c@(E.Colonnade cs)) =
+ let parentSz :: Dynamic t (Sum Int)
+ parentSz = foldMap (\(E.OneColonnade h _) -> (coerceDynamic (sizableSize h) :: Dynamic t (Sum Int))) cs
+ in E.AnnotatedCorniceBase (coerceDynamic parentSz) (C.mapHeadedness (\h -> E.Sized (sizableSize h) (sizableCast (Proxy :: Proxy t) h)) c)
+ go (E.CorniceCap children) =
+ let annChildren = fmap (mapOneCorniceBody go) children
+ parentSz :: Dynamic t (Sum Int)
+ parentSz = foldMap (\(E.OneCornice _ theBody) -> (coerceDynamic (E.size theBody) :: Dynamic t (Sum Int))) annChildren
+ in E.AnnotatedCorniceCap (coerceDynamic parentSz) annChildren
+
mapOneCorniceBody :: (forall p' a' c'. k p' a' c' -> j p' a' c') -> E.OneCornice k p a c -> E.OneCornice j p a c
mapOneCorniceBody f (E.OneCornice h b) = E.OneCornice h (f b)
@@ -511,7 +576,7 @@ encodeCorniceHeadDynamic ::
(DomBuilder t m, PostBuild t m, Monoid e)
=> Dynamic t (M.Map T.Text T.Text)
-> Fascia p (Dynamic t (M.Map T.Text T.Text))
- -> E.AnnotatedCornice (Maybe Int) p a (Cell t m e)
+ -> E.AnnotatedCornice (Maybe Int) Headed p a (Cell t m e)
-> m e
encodeCorniceHeadDynamic headAttrs fascia annCornice =
elDynAttr "thead" headAttrs (unWrappedApplicative thead)
@@ -521,7 +586,7 @@ encodeCorniceHeadDynamic headAttrs fascia annCornice =
addAttr attrs = WrappedApplicative . elDynAttr "tr" attrs . unWrappedApplicative
dynamicCapped ::
- (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Semigroup e, Monoid e)
+ (DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Semigroup e, Monoid e)
=> Dynamic t (M.Map T.Text T.Text) -- ^ @\@ tag attributes
-> Dynamic t (M.Map T.Text T.Text) -- ^ @\@ tag attributes
-> Dynamic t (M.Map T.Text T.Text) -- ^ @\@ tag attributes
@@ -629,6 +694,46 @@ paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination pageSize
return e
_ -> error "Reflex.Dom.Colonnade: paginated: write this code"
+paginatedCapped :: forall t b h m a c p e.
+ (Sizable t b h, Cellular t m c, Headedness b, MonadFix m, Functor h, MonadHold t m, Monoid e)
+ => Chest p t a
+ -> Pagination t m -- ^ pagination settings
+ -> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows.
+ -> Cornice h p (Dynamic t a) (c e) -- ^ Data encoding strategy
+ -> Dynamic t (Vector a) -- ^ table row data
+ -> m e
+paginatedCapped (Chest tableAttrs theadAttrs fascia bodyAttrs trAttrs) (Pagination pageSize arrange makePagination) aDef col vecD = do
+ let colLifted :: Cornice h p (Dynamic t (Visible a)) (c e)
+ colLifted = PF.lmap (fmap (\(Visible _ a) -> a)) col
+ makeVals :: Dynamic t Int -> Vector (Dynamic t (Visible a))
+ makeVals page = V.generate pageSize $ \ix -> do
+ p <- page
+ v <- vecD
+ return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
+ totalPages :: Dynamic t Int
+ totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
+ hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
+ hideWhenUnipage = zipDynWith
+ ( \ct attrs -> if ct > 1 then attrs else M.insert "style" "display:none;" attrs
+ ) totalPages
+ trAttrsLifted :: Dynamic t (Visible a) -> Dynamic t (Map Text Text)
+ trAttrsLifted d = do
+ Visible isVisible a <- d
+ attrs <- trAttrs a
+ return (if isVisible then attrs else M.insertWith T.append "style" "display:none;" attrs)
+ elDynAttr "table" tableAttrs $ case arrange of
+ ArrangementFooter tfootAttrs tfootTrAttrs tfootThAttrs -> mdo
+ let vals = makeVals page
+ (e, size) <- cappedTableless theadAttrs bodyAttrs trAttrsLifted fascia colLifted vals
+ page <- elDynAttr "tfoot" (hideWhenUnipage tfootAttrs) $ do
+ elDynAttr "tr" tfootTrAttrs $ do
+ let attrs = zipDynWith insertSizeAttr size tfootThAttrs
+ elDynAttr "th" attrs $ do
+ makePagination totalPages
+ return e
+ _ -> error "Reflex.Dom.Colonnade: paginatedCapped: write this code"
+
+
-- | A paginated table with a fixed number of rows. Each row can
-- expand a section beneath it, represented as an additional
-- table row. CSS rules that give the table a striped appearance
@@ -650,17 +755,15 @@ paginatedExpandable (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) (Pagination
expansionLifted = expansion . fmap (\(Visible _ a) -> a)
makeVals :: Dynamic t Int -> Vector (Dynamic t (Visible a))
makeVals page = V.generate pageSize $ \ix -> do
- p <- page
- v <- vecD
- return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
+ p <- page
+ v <- vecD
+ return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
totalPages :: Dynamic t Int
totalPages = fmap ((`divRoundUp` pageSize) . V.length) vecD
hideWhenUnipage :: Dynamic t (Map Text Text) -> Dynamic t (Map Text Text)
hideWhenUnipage = zipDynWith
( \ct attrs -> if ct > 1 then attrs else M.insert "style" "display:none;" attrs
) totalPages
- -- trAttrsLifted :: Visible a -> Dynamic t (Map Text Text)
- -- trAttrsLifted (Visible _ a) = trAttrs a
trAttrsLifted :: Dynamic t (Visible a) -> Dynamic t (Map Text Text)
trAttrsLifted d = do
Visible isVisible a <- d
diff --git a/siphon/siphon.cabal b/siphon/siphon.cabal
index 68fe286..94ed8ef 100644
--- a/siphon/siphon.cabal
+++ b/siphon/siphon.cabal
@@ -1,5 +1,5 @@
name: siphon
-version: 0.7.1
+version: 0.7.2
synopsis: Encode and decode CSV files
description: Please see README.md
homepage: https://github.com/andrewthad/colonnade#readme
@@ -19,7 +19,7 @@ library
Siphon.Types
build-depends:
base >= 4.9 && < 5
- , colonnade >= 1.1 && < 1.2
+ , colonnade >= 1.1 && < 1.3
, text
, bytestring
, vector
diff --git a/yesod-colonnade/src/Yesod/Colonnade.hs b/yesod-colonnade/src/Yesod/Colonnade.hs
index b54ac2a..845bb22 100644
--- a/yesod-colonnade/src/Yesod/Colonnade.hs
+++ b/yesod-colonnade/src/Yesod/Colonnade.hs
@@ -136,7 +136,7 @@ encodeHeadedCellTable :: Foldable f
-> f a -- ^ Rows of data
-> WidgetT site IO ()
encodeHeadedCellTable = encodeTable
- (Just mempty) mempty (const mempty) widgetFromCell
+ (E.Headed mempty) mempty (const mempty) widgetFromCell
encodeHeadlessCellTable :: Foldable f
=> Attribute -- ^ Attributes of @table@ element
@@ -144,7 +144,7 @@ encodeHeadlessCellTable :: Foldable f
-> f a -- ^ Rows of data
-> WidgetT site IO ()
encodeHeadlessCellTable = encodeTable
- Nothing mempty (const mempty) widgetFromCell
+ E.Headless mempty (const mempty) widgetFromCell
encodeHeadedWidgetTable :: Foldable f
=> Attribute -- ^ Attributes of @table@ element
@@ -152,7 +152,7 @@ encodeHeadedWidgetTable :: Foldable f
-> f a -- ^ Rows of data
-> WidgetT site IO ()
encodeHeadedWidgetTable = encodeTable
- (Just mempty) mempty (const mempty) ($ mempty)
+ (E.Headed mempty) mempty (const mempty) ($ mempty)
encodeHeadlessWidgetTable :: Foldable f
=> Attribute -- ^ Attributes of @\@ element
@@ -160,14 +160,14 @@ encodeHeadlessWidgetTable :: Foldable f
-> f a -- ^ Rows of data
-> WidgetT site IO ()
encodeHeadlessWidgetTable = encodeTable
- Nothing mempty (const mempty) ($ mempty)
+ E.Headless mempty (const mempty) ($ mempty)
-- | Encode a table. This handles a very general case and
-- is seldom needed by users. One of the arguments provided is
-- used to add attributes to the generated @\@ elements.
encodeTable ::
- (Foldable f, Foldable h)
- => Maybe Attribute -- ^ Attributes of @\@, pass 'Nothing' to omit @\@
+ (Foldable f, E.Headedness h)
+ => h Attribute -- ^ Attributes of @\@, pass 'Nothing' to omit @\@
-> Attribute -- ^ Attributes of @\
@ element
-> (a -> Attribute) -- ^ Attributes of each @\@ element
-> ((Attribute -> WidgetT site IO () -> WidgetT site IO ()) -> c -> WidgetT site IO ()) -- ^ Wrap content and convert to 'Html'
@@ -175,10 +175,10 @@ encodeTable ::
-> Colonnade h a c -- ^ How to encode data as a row
-> f a -- ^ Collection of data
-> WidgetT site IO ()
-encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
+encodeTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
table_ tableAttrs $ do
- for_ mtheadAttrs $ \theadAttrs -> do
- thead_ theadAttrs $ do
+ for_ E.headednessExtract $ \unhead ->
+ thead_ (unhead theadAttrs) $ do
E.headerMonadicGeneral_ colonnade (wrapContent th_)
tbody_ tbodyAttrs $ do
forM_ xs $ \x -> do
diff --git a/yesod-colonnade/yesod-colonnade.cabal b/yesod-colonnade/yesod-colonnade.cabal
index 8f128e6..7f15b69 100644
--- a/yesod-colonnade/yesod-colonnade.cabal
+++ b/yesod-colonnade/yesod-colonnade.cabal
@@ -1,5 +1,5 @@
name: yesod-colonnade
-version: 1.1.0
+version: 1.2.0
synopsis: Helper functions for using yesod with colonnade
description: Yesod and colonnade
homepage: https://github.com/andrewthad/colonnade#readme
@@ -18,7 +18,7 @@ library
Yesod.Colonnade
build-depends:
base >= 4.7 && < 5
- , colonnade >= 1.1 && < 1.2
+ , colonnade >= 1.2 && < 1.3
, yesod-core >= 1.4 && < 1.5
, text >= 1.0 && < 1.3
, blaze-markup >= 0.7 && < 0.9