mirror of
https://github.com/byteverse/colonnade.git
synced 2024-10-26 16:14:12 +03:00
start using typeclass to make headed vs headless more convenient. add paginated for reflex-dom
This commit is contained in:
parent
11f9a10268
commit
24a2c1d142
@ -12,6 +12,8 @@ module Colonnade
|
||||
Colonnade
|
||||
, Headed(..)
|
||||
, Headless(..)
|
||||
-- * Typeclasses
|
||||
, E.Headedness(..)
|
||||
-- * Create
|
||||
, headed
|
||||
, headless
|
||||
|
@ -44,6 +44,9 @@ module Colonnade.Encode
|
||||
, Headed(..)
|
||||
, Headless(..)
|
||||
, Sized(..)
|
||||
, ExtractForall(..)
|
||||
-- ** Typeclasses
|
||||
, Headedness(..)
|
||||
-- ** Row
|
||||
, row
|
||||
, rowMonadic
|
||||
@ -234,12 +237,13 @@ headerMonadic (Colonnade v) g =
|
||||
fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneColonnadeHead) v
|
||||
|
||||
headerMonadicGeneral_ ::
|
||||
(Monad m, Foldable h)
|
||||
(Monad m, Headedness h)
|
||||
=> Colonnade h a c
|
||||
-> (c -> m b)
|
||||
-> m ()
|
||||
headerMonadicGeneral_ (Colonnade v) g =
|
||||
Vector.mapM_ (mapM_ g . oneColonnadeHead) v
|
||||
headerMonadicGeneral_ (Colonnade v) g = case headednessExtract of
|
||||
Nothing -> return ()
|
||||
Just f -> Vector.mapM_ (g . f . oneColonnadeHead) v
|
||||
|
||||
headerMonoidalGeneral ::
|
||||
(Monoid m, Foldable h)
|
||||
@ -493,6 +497,10 @@ data MutableSizedColonnade s h a c = MutableSizedColonnade
|
||||
newtype Headed a = Headed { getHeaded :: a }
|
||||
deriving (Eq,Ord,Functor,Show,Read,Foldable)
|
||||
|
||||
instance Applicative Headed where
|
||||
pure = Headed
|
||||
Headed f <*> Headed a = Headed (f a)
|
||||
|
||||
-- | As the first argument to the 'Colonnade' type
|
||||
-- constructor, this indictates that the columnar encoding does not have
|
||||
-- a header. This type is isomorphic to 'Proxy' but is
|
||||
@ -505,6 +513,10 @@ newtype Headed a = Headed { getHeaded :: a }
|
||||
data Headless a = Headless
|
||||
deriving (Eq,Ord,Functor,Show,Read,Foldable)
|
||||
|
||||
instance Applicative Headless where
|
||||
pure _ = Headless
|
||||
Headless <*> Headless = Headless
|
||||
|
||||
data Sized sz f a = Sized
|
||||
{ sizedSize :: !sz
|
||||
, sizedContent :: !(f a)
|
||||
@ -620,8 +632,38 @@ data AnnotatedCornice sz (p :: Pillar) a c where
|
||||
|
||||
-- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt
|
||||
|
||||
-- | This is provided with vector-0.12, but we include a copy here
|
||||
-- | This is provided with @vector-0.12@, but we include a copy here
|
||||
-- for compatibility.
|
||||
vectorConcatNE :: NonEmpty (Vector a) -> Vector a
|
||||
vectorConcatNE = Vector.concat . toList
|
||||
|
||||
-- | This class communicates that a container holds either zero
|
||||
-- elements or one element. Furthermore, all inhabitants of
|
||||
-- the type must hold the same number of elements. Both
|
||||
-- 'Headed' and 'Headless' have instances. The following
|
||||
-- law accompanies any instances:
|
||||
--
|
||||
-- > maybe x (\f -> f (headednessPure x)) headednessContents == x
|
||||
-- > todo: come up with another law that relates to Traversable
|
||||
--
|
||||
-- Consequently, there is no instance for 'Maybe', which cannot
|
||||
-- satisfy the laws since it has inhabitants which hold different
|
||||
-- numbers of elements. 'Nothing' holds 0 elements and 'Just' holds
|
||||
-- 1 element.
|
||||
class Headedness h where
|
||||
headednessPure :: a -> h a
|
||||
headednessExtract :: Maybe (h a -> a)
|
||||
headednessExtractForall :: Maybe (ExtractForall h)
|
||||
|
||||
instance Headedness Headed where
|
||||
headednessPure = Headed
|
||||
headednessExtract = Just getHeaded
|
||||
headednessExtractForall = Just (ExtractForall getHeaded)
|
||||
|
||||
instance Headedness Headless where
|
||||
headednessPure _ = Headless
|
||||
headednessExtract = Nothing
|
||||
headednessExtractForall = Nothing
|
||||
|
||||
newtype ExtractForall h = ExtractForall { runExtractForall :: forall a. h a -> a }
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: reflex-dom-colonnade
|
||||
version: 0.5.0
|
||||
version: 0.6.0
|
||||
synopsis: Use colonnade with reflex-dom
|
||||
description: Please see README.md
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
@ -25,6 +25,7 @@ library
|
||||
, reflex == 0.5.*
|
||||
, reflex-dom == 0.4.*
|
||||
, containers >= 0.5 && < 0.6
|
||||
, profunctors >= 5.2 && < 5.3
|
||||
default-language: Haskell2010
|
||||
|
||||
source-repository head
|
||||
|
@ -3,8 +3,12 @@
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE RecursiveDo #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
@ -16,6 +20,9 @@ module Reflex.Dom.Colonnade
|
||||
-- * Types
|
||||
Cell(..)
|
||||
, Resizable(..)
|
||||
, Bureau(..)
|
||||
, Arrangement(..)
|
||||
, Pagination(..)
|
||||
-- * Table Encoders
|
||||
, basic
|
||||
, static
|
||||
@ -27,8 +34,9 @@ module Reflex.Dom.Colonnade
|
||||
, dynamic
|
||||
, dynamicCapped
|
||||
, expandable
|
||||
, expandableResizableTableless
|
||||
-- , expandableResizableTableless
|
||||
, sectioned
|
||||
, paginated
|
||||
-- * Cell Functions
|
||||
, cell
|
||||
, charCell
|
||||
@ -37,6 +45,8 @@ module Reflex.Dom.Colonnade
|
||||
, lazyTextCell
|
||||
, builderCell
|
||||
, headedResizable
|
||||
-- * Other Stuff
|
||||
, defBureau
|
||||
) where
|
||||
|
||||
import Data.String (IsString(..))
|
||||
@ -45,15 +55,19 @@ import qualified Data.Text.Lazy as LT
|
||||
import qualified Data.Text.Lazy.Builder as LT
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Profunctor as PF
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Vector (Vector)
|
||||
import Data.Text (Text)
|
||||
import Data.Foldable (Foldable(..),for_,forM_)
|
||||
import Data.Foldable (Foldable(..),for_,forM_,foldlM)
|
||||
import Data.Traversable (for)
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
import Control.Applicative (liftA2)
|
||||
import Reflex.Dom
|
||||
import Colonnade (Colonnade,Headed,Fascia,Cornice)
|
||||
import Colonnade (Colonnade,Headed,Headless,Fascia,Cornice,Headedness(..))
|
||||
import Data.Monoid (Sum(..))
|
||||
import Data.Proxy
|
||||
import Control.Monad.Fix (MonadFix)
|
||||
import qualified Colonnade as C
|
||||
import qualified Colonnade.Encode as E
|
||||
|
||||
@ -67,11 +81,100 @@ data Cell t m b = Cell
|
||||
data Resizable t h b = Resizable
|
||||
{ resizableSize :: !(Dynamic t Int)
|
||||
, resizableContent :: !(h b)
|
||||
} deriving (Foldable)
|
||||
} deriving (Foldable, Functor)
|
||||
|
||||
data Bureau t h a = Bureau
|
||||
{ bureauTable :: Dynamic t (Map Text Text)
|
||||
-- ^ attributes of @\<table\>@
|
||||
, bureauHead :: h (Dynamic t (Map Text Text), Dynamic t (Map Text Text))
|
||||
-- ^ attributes of @\<thead\>@ and of the @\<tr\>@ inside of it.
|
||||
, bureauBody :: Dynamic t (Map Text Text)
|
||||
, bureauRow :: (a -> Dynamic t (Map Text Text))
|
||||
-- ^ attributes of each @\<tr\>@, based on the element
|
||||
}
|
||||
-- , bureauHeadRow :: h (Dynamic t (Map Text Text))
|
||||
|
||||
-- | Where the pagination goes relative to the table
|
||||
data Arrangement t
|
||||
= ArrangementAbove
|
||||
| ArrangementBeneath
|
||||
| ArrangementFooter
|
||||
(Dynamic t (Map Text Text))
|
||||
(Dynamic t (Map Text Text))
|
||||
(Dynamic t (Map Text Text))
|
||||
-- ^ contains attributes of @\<tfoot\>@, its inner @\<tr\>@, and its inner @\<th\>@.
|
||||
|
||||
-- | 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
|
||||
|
||||
instance (PostBuild t m, DomBuilder t m) => Cellular t m (Cell t m) where
|
||||
cellularAttrs = cellAttrs
|
||||
cellularContents = cellContents
|
||||
|
||||
instance (Reflex t, DomBuilder t m, PerformEvent t m, MonadHold t m, MonadFix m) => Cellular t (PostBuildT t m) (PostBuildT t m) where
|
||||
cellularAttrs _ = pure M.empty
|
||||
cellularContents = id
|
||||
|
||||
|
||||
-- | This typeclass is provided to make using functions in this
|
||||
-- library more convenient. The methods could have been passed
|
||||
-- around in a dictionary instead, but there is only really one
|
||||
-- sensible implementation for each header type. The only
|
||||
-- law it should satisfy is:
|
||||
--
|
||||
-- > sizableSize (headednessPure Proxy x) == pure 1
|
||||
--
|
||||
-- Also, since the instances we are interested in preclude
|
||||
-- the use of a functional dependency, the typeclass is annoying
|
||||
-- to use. But, end users should never need to use it.
|
||||
class Sizable t b h | h -> b where
|
||||
sizableSize :: h a -> Dynamic t Int
|
||||
sizableCast :: Proxy t -> h a -> b a
|
||||
|
||||
-- instance (Headedness h, Reflex t) => Headedness (Resizable t h) where
|
||||
-- headednessPure = Resizable (pure 1) . headednessPure
|
||||
-- headednessContents = do
|
||||
-- f <- headednessContents
|
||||
-- Just (\(Resizable _ a) -> f a)
|
||||
|
||||
instance (Headedness h, Reflex t) => Sizable t h (Resizable t h) where
|
||||
sizableSize = resizableSize
|
||||
sizableCast _ (Resizable _ h) = h
|
||||
|
||||
instance Reflex t => Sizable t Headed Headed where
|
||||
sizableSize _ = pure 1
|
||||
sizableCast _ = id
|
||||
|
||||
instance Reflex t => Sizable t Headless Headless where
|
||||
sizableSize _ = pure 1
|
||||
sizableCast _ = id
|
||||
|
||||
defBureau :: forall t h a. (Reflex t, Headedness h) => Bureau t h a
|
||||
defBureau = Bureau
|
||||
{ bureauTable = pure M.empty
|
||||
, bureauHead = headednessPure (pure M.empty, pure M.empty)
|
||||
, bureauBody = pure M.empty
|
||||
, bureauRow = const (pure M.empty)
|
||||
}
|
||||
|
||||
elFromCell :: (DomBuilder t m, PostBuild t m) => T.Text -> Cell t m b -> m b
|
||||
elFromCell e (Cell attr m) = elDynAttr e attr m
|
||||
|
||||
-- elFromCellular :: (Cellular t m c, PostBuild t m, DomBuilder t m)
|
||||
-- => T.Text -- name of the element, @th@ or @td@
|
||||
-- -> c b -- cellular value
|
||||
-- -> m b
|
||||
-- elFromCellular name c = elDynAttr name (cellularAttrs c) (cellularContents c)
|
||||
|
||||
-- | Convenience function for creating a 'Cell' representing
|
||||
-- a @td@ or @th@ with no attributes.
|
||||
cell :: Reflex t => m b -> Cell t m b
|
||||
@ -121,13 +224,13 @@ basic ::
|
||||
basic tableAttrs = static tableAttrs (Just (M.empty,M.empty)) mempty (const mempty)
|
||||
|
||||
body :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
|
||||
=> M.Map T.Text T.Text
|
||||
=> Dynamic t (M.Map T.Text T.Text)
|
||||
-> (a -> Dynamic t (M.Map T.Text T.Text))
|
||||
-> Colonnade h a (Cell t m e)
|
||||
-> f a
|
||||
-> m e
|
||||
body bodyAttrs trAttrs colonnade collection =
|
||||
elAttr "tbody" bodyAttrs (bodyRows trAttrs colonnade collection)
|
||||
elDynAttr "tbody" bodyAttrs (bodyRows trAttrs colonnade collection)
|
||||
|
||||
bodyRows :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
|
||||
=> (a -> Dynamic t (M.Map T.Text T.Text))
|
||||
@ -160,7 +263,7 @@ setColspanOrHide i m
|
||||
| otherwise = M.insert "colspan" (T.pack (show i)) m
|
||||
|
||||
static ::
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Monoid e)
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Monoid e)
|
||||
=> M.Map T.Text T.Text -- ^ @\<table\>@ tag attributes
|
||||
-> Maybe (M.Map T.Text T.Text, M.Map T.Text T.Text)
|
||||
-- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
||||
@ -174,10 +277,10 @@ static tableAttrs mheadAttrs bodyAttrs trAttrs colonnade collection =
|
||||
for_ mheadAttrs $ \(headAttrs,headTrAttrs) ->
|
||||
elAttr "thead" headAttrs . elAttr "tr" headTrAttrs $
|
||||
E.headerMonadicGeneral_ colonnade (elFromCell "th")
|
||||
body bodyAttrs (pure . trAttrs) colonnade collection
|
||||
body (pure bodyAttrs) (pure . trAttrs) colonnade collection
|
||||
|
||||
staticTableless ::
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Monoid e)
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Monoid e)
|
||||
=> Maybe (M.Map T.Text T.Text, M.Map T.Text T.Text)
|
||||
-- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
||||
-> M.Map T.Text T.Text -- ^ @\<tbody\>@ tag attributes
|
||||
@ -189,12 +292,12 @@ staticTableless mheadAttrs bodyAttrs trAttrs colonnade collection = do
|
||||
for_ mheadAttrs $ \(headAttrs,headTrAttrs) ->
|
||||
elAttr "thead" headAttrs . elAttr "tr" headTrAttrs $
|
||||
E.headerMonadicGeneral_ colonnade (elFromCell "th")
|
||||
body bodyAttrs trAttrs colonnade collection
|
||||
body (pure bodyAttrs) trAttrs colonnade collection
|
||||
|
||||
-- | A table dividing into sections by @\<td\>@ elements that
|
||||
-- take up entire rows.
|
||||
sectioned ::
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Foldable g)
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Foldable g)
|
||||
=> M.Map T.Text T.Text -- ^ @\<table\>@ tag attributes
|
||||
-> Maybe (M.Map T.Text T.Text, M.Map T.Text T.Text)
|
||||
-- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
||||
@ -258,7 +361,7 @@ capped ::
|
||||
capped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
||||
elAttr "table" tableAttrs $ do
|
||||
h <- encodeCorniceHead headAttrs fascia (E.annotate cornice)
|
||||
b <- body bodyAttrs (pure . trAttrs) (E.discard cornice) collection
|
||||
b <- body (pure bodyAttrs) (pure . trAttrs) (E.discard cornice) collection
|
||||
return (h `mappend` b)
|
||||
|
||||
-- | This is useful when you want to be able to toggle the visibility
|
||||
@ -366,7 +469,7 @@ dynamicBody bodyAttrs trAttrs colonnade dynCollection =
|
||||
unWrappedApplicative . E.rowMonoidal colonnade (WrappedApplicative . elFromCell "td") $ a
|
||||
|
||||
dynamic ::
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Semigroup e, Monoid e)
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Headedness h, Semigroup e, Monoid e)
|
||||
=> Dynamic t (M.Map T.Text T.Text) -- ^ @\<table\>@ tag attributes
|
||||
-> Maybe (Dynamic t (M.Map T.Text T.Text), Dynamic t (M.Map T.Text T.Text))
|
||||
-- ^ Attributes of @\<thead\>@ and its @\<tr\>@, pass 'Nothing' to omit @\<thead\>@
|
||||
@ -438,22 +541,121 @@ expandable tableAttrs tdExpandedAttrs as encoding@(E.Colonnade v) = do
|
||||
return e'
|
||||
widgetHold (return ()) e'
|
||||
|
||||
expandableResizableTableless :: forall t m f a b. (MonadWidget t m, Foldable f)
|
||||
=> f a -- ^ Values
|
||||
-> (Event t b -> m ())
|
||||
-- ^ Encoding over additional content
|
||||
-> Colonnade (Resizable t Headed) a (m (Event t (Maybe b)))
|
||||
-- ^ Encoding into cells with events that can fire to create additional content under the row
|
||||
-- expandableResizableTableless :: forall t m f a b. (MonadWidget t m, Foldable f)
|
||||
-- => f a -- ^ Values
|
||||
-- -> (Event t b -> m ())
|
||||
-- -- ^ Encoding over additional content
|
||||
-- -> Colonnade (Resizable t Headed) a (m (Event t (Maybe b)))
|
||||
-- -- ^ Encoding into cells with events that can fire to create additional content under the row
|
||||
-- -> m ()
|
||||
-- expandableResizableTableless as expansion encoding@(E.Colonnade v) = do
|
||||
-- let vlen = coerceDynamic (foldMap (\(E.OneColonnade (Resizable sz _) _) -> coerceDynamic sz :: Dynamic t (Sum Int)) v) :: Dynamic t (Sum Int)
|
||||
-- totalSizeAttr = fmap (\i -> M.singleton "colspan" (T.pack (show i))) vlen
|
||||
-- _ <- el "thead" $ el "tr" $ E.headerMonadicGeneral_ encoding (el "th")
|
||||
-- el "tbody" $ forM_ as $ \a -> do
|
||||
-- x <- el "tr" $ E.rowMonadicWith [] (++) encoding (fmap (\k -> [k]) . el "td") a
|
||||
-- let e = leftmost x
|
||||
-- d <- holdDyn Nothing e
|
||||
-- elDynAttr "tr" (fmap (maybe (M.singleton "style" "display:none;") (const M.empty)) d) $ do
|
||||
-- elDynAttr "td" totalSizeAttr (expansion (fmapMaybe id e))
|
||||
|
||||
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
|
||||
-> a -- ^ An inhabitant of type @a@ only used for the cells in hidden rows.
|
||||
-> Colonnade h (Dynamic t a) (c ())
|
||||
-> Dynamic t (Vector a)
|
||||
-> m ()
|
||||
expandableResizableTableless as expansion encoding@(E.Colonnade v) = do
|
||||
let vlen = coerceDynamic (foldMap (\(E.OneColonnade (Resizable sz _) _) -> coerceDynamic sz :: Dynamic t (Sum Int)) v) :: Dynamic t (Sum Int)
|
||||
totalSizeAttr = fmap (\i -> M.singleton "colspan" (T.pack (show i))) vlen
|
||||
_ <- el "thead" $ el "tr" $ E.headerMonadicGeneral_ encoding (el "th")
|
||||
el "tbody" $ forM_ as $ \a -> do
|
||||
x <- el "tr" $ E.rowMonadicWith [] (++) encoding (fmap (\k -> [k]) . el "td") a
|
||||
let e = leftmost x
|
||||
d <- holdDyn Nothing e
|
||||
elDynAttr "tr" (fmap (maybe (M.singleton "style" "display:none;") (const M.empty)) d) $ do
|
||||
elDynAttr "td" totalSizeAttr (expansion (fmapMaybe id e))
|
||||
paginated (Bureau tableAttrs theadAttrs bodyAttrs trAttrs) arrange (Pagination makePagination) pageSize 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
|
||||
v <- vecD
|
||||
return (maybe (Visible False aDef) (Visible True) (v V.!? (p * pageSize + ix)))
|
||||
totalPages :: Dynamic t Int
|
||||
totalPages = fmap ((`div` pageSize) . V.length) vecD
|
||||
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
|
||||
tableHeader theadAttrs colLifted
|
||||
let vals = makeVals page
|
||||
tableBody bodyAttrs trAttrsLifted colLifted vals
|
||||
page <- elDynAttr "tfoot" tfootAttrs $ do
|
||||
elDynAttr "tr" tfootTrAttrs $ do
|
||||
elDynAttr "th" tfootThAttrs $ do
|
||||
makePagination totalPages
|
||||
return ()
|
||||
_ -> error "Reflex.Dom.Colonnade: paginated: write this code"
|
||||
|
||||
|
||||
tableHeader :: forall t b h c a m.
|
||||
(Reflex t, Sizable t b h, Cellular t m c, Headedness b)
|
||||
=> b (Dynamic t (Map Text Text), Dynamic t (Map Text Text))
|
||||
-> Colonnade h a (c ())
|
||||
-> m ()
|
||||
tableHeader theadAttrsWrap col = case headednessExtractForall of
|
||||
Nothing -> return ()
|
||||
Just extractForall -> do
|
||||
let (theadAttrs,trAttrs) = extract theadAttrsWrap
|
||||
elDynAttr "thead" theadAttrs $ do
|
||||
elDynAttr "tr" trAttrs $ do
|
||||
headerMonadicGeneralSizable_ col (extract . sizableCast (Proxy :: Proxy t))
|
||||
where
|
||||
extract :: forall x. b x -> x
|
||||
extract = E.runExtractForall extractForall
|
||||
|
||||
tableBody :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e, Cellular t m c, Sizable t b h)
|
||||
=> Dynamic t (M.Map T.Text T.Text)
|
||||
-> (a -> Dynamic t (M.Map T.Text T.Text))
|
||||
-> Colonnade h a (c e)
|
||||
-> f a
|
||||
-> m e
|
||||
tableBody bodyAttrs trAttrs col collection =
|
||||
elDynAttr "tbody" bodyAttrs $ foldlM (\m a -> do
|
||||
e <- elDynAttr "tr" (trAttrs a) (rowSizable col a)
|
||||
return (mappend m e)
|
||||
) mempty collection
|
||||
|
||||
headerMonadicGeneralSizable_ :: (Sizable t b h, Cellular t m c)
|
||||
=> Colonnade h a (c ())
|
||||
-> (h (c ()) -> c ())
|
||||
-> m ()
|
||||
headerMonadicGeneralSizable_ (E.Colonnade v) extract =
|
||||
V.mapM_ go v
|
||||
where
|
||||
go x = do
|
||||
let h = E.oneColonnadeHead x
|
||||
c = extract h
|
||||
attrs = zipDynWith insertSizeAttr (sizableSize h) (cellularAttrs c)
|
||||
elDynAttr "th" attrs (cellularContents c)
|
||||
|
||||
rowSizable :: (Sizable t b h, Cellular t m c, Monoid e)
|
||||
=> Colonnade h a (c e)
|
||||
-> a
|
||||
-> m e
|
||||
rowSizable (E.Colonnade v) a = V.foldM (\m oc -> do
|
||||
let c = E.oneColonnadeEncode oc a
|
||||
e <- elDynAttr "td" (cellularAttrs c) $ do
|
||||
cellularContents c
|
||||
return (mappend m e)
|
||||
) mempty v
|
||||
|
||||
insertSizeAttr :: Int -> Map Text Text -> Map Text Text
|
||||
insertSizeAttr i m
|
||||
| i < 1 = M.insertWith T.append "style" "display:none;" m
|
||||
| otherwise = M.insert "colspan" (T.pack (show i)) m
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user