make annotated cornice more flexible, allow reflex-dom tables whose columns can be hidden
This commit is contained in:
Andrew Martin
parent
a0b4b1aa7e
commit
01a75dc318
@ -341,7 +341,7 @@ encodeTable mtheadAttrs tbodyAttrs trAttrs wrapContent tableAttrs colonnade xs =
|
||||
encodeCappedCellTable :: Foldable f
|
||||
=> Attribute -- ^ Attributes of @\<table\>@ element
|
||||
-> Fascia p Attribute -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
|
||||
-> Cornice p a Cell
|
||||
-> Cornice Headed p a Cell
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeCappedCellTable = encodeCappedTable mempty mempty (const mempty) htmlFromCell
|
||||
@ -356,7 +356,7 @@ encodeCappedTable :: Foldable f
|
||||
-> ((Html -> Html) -> c -> Html) -- ^ Wrap content and convert to 'Html'
|
||||
-> Attribute -- ^ Attributes of @\<table\>@ element
|
||||
-> Fascia p Attribute -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
|
||||
-> Cornice p a c
|
||||
-> Cornice Headed p a c
|
||||
-> f a -- ^ Collection of data
|
||||
-> Html
|
||||
encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia cornice xs = do
|
||||
@ -366,7 +366,12 @@ encodeCappedTable theadAttrs tbodyAttrs trAttrs wrapContent tableAttrs fascia co
|
||||
H.thead ! theadAttrs $ do
|
||||
Encode.headersMonoidal
|
||||
(Just (fascia, \attrs theHtml -> H.tr ! attrs $ theHtml))
|
||||
[(\sz c -> wrapContent H.th c ! HA.colspan (H.toValue (show sz)),id)]
|
||||
[ ( \msz c -> case msz of
|
||||
Just sz -> wrapContent H.th c ! HA.colspan (H.toValue (show sz))
|
||||
Nothing -> mempty
|
||||
, id
|
||||
)
|
||||
]
|
||||
annCornice
|
||||
-- H.tr ! trAttrs $ do
|
||||
-- Encode.headerMonoidalGeneral colonnade (wrapContent H.th)
|
||||
|
||||
@ -272,7 +272,7 @@ replaceWhen = modifyWhen . const
|
||||
--
|
||||
-- >>> let cor = mconcat [cap "Person" colPersonFst, cap "House" colHouseSnd]
|
||||
-- >>> :t cor
|
||||
-- cor :: Cornice ('Cap 'Base) (Person, House) [Char]
|
||||
-- cor :: Cornice Headed ('Cap 'Base) (Person, House) [Char]
|
||||
-- >>> putStr (asciiCapped cor personHomePairs)
|
||||
-- +-------------+-----------------+
|
||||
-- | Person | House |
|
||||
@ -284,7 +284,7 @@ replaceWhen = modifyWhen . const
|
||||
-- | Sonia | 12 | Green | $150000 |
|
||||
-- +-------+-----+-------+---------+
|
||||
--
|
||||
cap :: c -> Colonnade Headed a c -> Cornice (Cap Base) a c
|
||||
cap :: c -> Colonnade h a c -> Cornice h (Cap Base) a c
|
||||
cap h = E.CorniceCap . Vector.singleton . E.OneCornice h . E.CorniceBase
|
||||
|
||||
-- | Add another cap to a cornice. There is no limit to how many times
|
||||
@ -319,11 +319,11 @@ cap h = E.CorniceCap . Vector.singleton . E.OneCornice h . E.CorniceBase
|
||||
-- | Weekday | $8 | $8 | $8 | $6 | $7 | $8 | $8 | $8 | $6 | $7 |
|
||||
-- | Weekend | $9 | $9 | $9 | $7 | $8 | $9 | $9 | $9 | $7 | $8 |
|
||||
-- +---------+----+----+----+------+-------+----+----+----+------+-------+
|
||||
recap :: c -> Cornice p a c -> Cornice (Cap p) a c
|
||||
recap :: c -> Cornice h p a c -> Cornice h (Cap p) a c
|
||||
recap h cor = E.CorniceCap (Vector.singleton (E.OneCornice h cor))
|
||||
|
||||
asciiCapped :: Foldable f
|
||||
=> Cornice p a String -- ^ columnar encoding
|
||||
=> Cornice Headed p a String -- ^ columnar encoding
|
||||
-> f a -- ^ rows
|
||||
-> String
|
||||
asciiCapped cor xs =
|
||||
@ -332,8 +332,16 @@ asciiCapped cor xs =
|
||||
sizedCol = E.uncapAnnotated annCor
|
||||
in E.headersMonoidal
|
||||
Nothing
|
||||
[ (\sz _ -> hyphens (sz + 2) ++ "+", \s -> "+" ++ s ++ "\n")
|
||||
, (\sz c -> " " ++ rightPad sz ' ' c ++ " |", \s -> "|" ++ s ++ "\n")
|
||||
[ ( \msz _ -> case msz of
|
||||
Just sz -> "+" ++ hyphens (sz + 2)
|
||||
Nothing -> ""
|
||||
, \s -> s ++ "+\n"
|
||||
)
|
||||
, ( \msz c -> case msz of
|
||||
Just sz -> "| " ++ rightPad sz ' ' c ++ " "
|
||||
Nothing -> ""
|
||||
, \s -> s ++ "|\n"
|
||||
)
|
||||
] annCor ++ asciiBody sizedCol xs
|
||||
|
||||
|
||||
@ -349,41 +357,49 @@ ascii :: Foldable f
|
||||
ascii col xs =
|
||||
let sizedCol = E.sizeColumns List.length xs col
|
||||
divider = concat
|
||||
[ "+"
|
||||
, E.headerMonoidalFull sizedCol
|
||||
(\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")
|
||||
, "\n"
|
||||
[ E.headerMonoidalFull sizedCol
|
||||
(\(E.Sized msz _) -> case msz of
|
||||
Just sz -> "+" ++ hyphens (sz + 2)
|
||||
Nothing -> ""
|
||||
)
|
||||
, "+\n"
|
||||
]
|
||||
in List.concat
|
||||
[ divider
|
||||
, concat
|
||||
[ "|"
|
||||
, E.headerMonoidalFull sizedCol
|
||||
(\(E.Sized s (Headed h)) -> " " ++ rightPad s ' ' h ++ " |")
|
||||
, "\n"
|
||||
[ E.headerMonoidalFull sizedCol
|
||||
(\(E.Sized msz (Headed h)) -> case msz of
|
||||
Just sz -> "| " ++ rightPad sz ' ' h ++ " "
|
||||
Nothing -> ""
|
||||
)
|
||||
, "|\n"
|
||||
]
|
||||
, asciiBody sizedCol xs
|
||||
]
|
||||
|
||||
asciiBody :: Foldable f
|
||||
=> Colonnade (E.Sized Headed) a String
|
||||
=> Colonnade (E.Sized (Maybe Int) Headed) a String
|
||||
-> f a
|
||||
-> String
|
||||
asciiBody sizedCol xs =
|
||||
let divider = concat
|
||||
[ "+"
|
||||
, E.headerMonoidalFull sizedCol
|
||||
(\(E.Sized sz _) -> hyphens (sz + 2) ++ "+")
|
||||
, "\n"
|
||||
[ E.headerMonoidalFull sizedCol
|
||||
(\(E.Sized msz _) -> case msz of
|
||||
Just sz -> "+" ++ hyphens (sz + 2)
|
||||
Nothing -> ""
|
||||
)
|
||||
, "+\n"
|
||||
]
|
||||
rowContents = foldMap
|
||||
(\x -> concat
|
||||
[ "|"
|
||||
, E.rowMonoidalHeader
|
||||
[ E.rowMonoidalHeader
|
||||
sizedCol
|
||||
(\(E.Sized sz _) c -> " " ++ rightPad sz ' ' c ++ " |")
|
||||
(\(E.Sized msz _) c -> case msz of
|
||||
Nothing -> ""
|
||||
Just sz -> "| " ++ rightPad sz ' ' c ++ " "
|
||||
)
|
||||
x
|
||||
, "\n"
|
||||
, "|\n"
|
||||
]
|
||||
) xs
|
||||
in List.concat
|
||||
|
||||
@ -175,7 +175,7 @@ sizeColumns :: (Foldable f, Foldable h)
|
||||
=> (c -> Int) -- ^ Get size from content
|
||||
-> f a
|
||||
-> Colonnade h a c
|
||||
-> Colonnade (Sized h) a c
|
||||
-> Colonnade (Sized (Maybe Int) h) a c
|
||||
sizeColumns toSize rows colonnade = runST $ do
|
||||
mcol <- newMutableSizedColonnade colonnade
|
||||
headerUpdateSize toSize mcol
|
||||
@ -187,14 +187,14 @@ newMutableSizedColonnade (Colonnade v) = do
|
||||
mv <- MVU.replicate (V.length v) 0
|
||||
return (MutableSizedColonnade v mv)
|
||||
|
||||
freezeMutableSizedColonnade :: MutableSizedColonnade s h a c -> ST s (Colonnade (Sized h) a c)
|
||||
freezeMutableSizedColonnade :: MutableSizedColonnade s h a c -> ST s (Colonnade (Sized (Maybe Int) h) a c)
|
||||
freezeMutableSizedColonnade (MutableSizedColonnade v mv) =
|
||||
if MVU.length mv /= V.length v
|
||||
then error "rowMonoidalSize: vector sizes mismatched"
|
||||
else do
|
||||
sizeVec <- VU.freeze mv
|
||||
return $ Colonnade
|
||||
$ V.map (\(OneColonnade h enc,sz) -> OneColonnade (Sized sz h) enc)
|
||||
$ V.map (\(OneColonnade h enc,sz) -> OneColonnade (Sized (Just sz) h) enc)
|
||||
$ V.zip v (GV.convert sizeVec)
|
||||
|
||||
rowMonadicWith ::
|
||||
@ -266,37 +266,41 @@ headerMonadic_ (Colonnade v) g = Vector.mapM_ (g . getHeaded . oneColonnadeHead)
|
||||
foldlMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
|
||||
foldlMapM f = foldlM (\b a -> fmap (mappend b) (f a)) mempty
|
||||
|
||||
discard :: Cornice p a c -> Colonnade Headed a c
|
||||
discard :: Cornice h p a c -> Colonnade h a c
|
||||
discard = go where
|
||||
go :: forall p a c. Cornice p a c -> Colonnade Headed a c
|
||||
go :: forall h p a c. Cornice h p a c -> Colonnade h a c
|
||||
go (CorniceBase c) = c
|
||||
go (CorniceCap children) = Colonnade (getColonnade . go . oneCorniceBody =<< children)
|
||||
|
||||
endow :: forall p a c. (c -> c -> c) -> Cornice p a c -> Colonnade Headed a c
|
||||
endow :: forall p a c. (c -> c -> c) -> Cornice Headed p a c -> Colonnade Headed a c
|
||||
endow f x = case x of
|
||||
CorniceBase colonnade -> colonnade
|
||||
CorniceCap v -> Colonnade (V.concatMap (\(OneCornice h b) -> go h b) v)
|
||||
where
|
||||
go :: forall p'. c -> Cornice p' a c -> Vector (OneColonnade Headed a c)
|
||||
go :: forall p'. c -> Cornice Headed p' a c -> Vector (OneColonnade Headed a c)
|
||||
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 p a c. AnnotatedCornice p a c -> Colonnade (Sized Headed) a c
|
||||
uncapAnnotated :: forall sz p a c.
|
||||
AnnotatedCornice sz p a c
|
||||
-> Colonnade (Sized sz Headed) 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 p' a c -> Vector (OneColonnade (Sized Headed) a c)
|
||||
go :: forall p'.
|
||||
AnnotatedCornice sz p' a c
|
||||
-> Vector (OneColonnade (Sized sz Headed) a c)
|
||||
go (AnnotatedCorniceBase _ (Colonnade v)) = v
|
||||
go (AnnotatedCorniceCap _ v) = V.concatMap (\(OneCornice _ b) -> go b) v
|
||||
|
||||
annotate :: Cornice p a c -> AnnotatedCornice p a c
|
||||
annotate :: Cornice Headed p a c -> AnnotatedCornice (Maybe Int) p a c
|
||||
annotate = go where
|
||||
go :: forall p a c. Cornice p a c -> AnnotatedCornice p a c
|
||||
go :: forall p a c. Cornice Headed p a c -> AnnotatedCornice (Maybe Int) p a c
|
||||
go (CorniceBase c) = let len = V.length (getColonnade c) in
|
||||
AnnotatedCorniceBase
|
||||
(if len > 0 then (Just len) else Nothing)
|
||||
(mapHeadedness (Sized 1) c)
|
||||
(mapHeadedness (Sized (Just 1)) c)
|
||||
go (CorniceCap children) =
|
||||
let annChildren = fmap (mapOneCorniceBody go) children
|
||||
in AnnotatedCorniceCap
|
||||
@ -324,8 +328,8 @@ annotateFinely :: Foldable f
|
||||
-> (Int -> Int) -- ^ finalize
|
||||
-> (c -> Int) -- ^ Get size from content
|
||||
-> f a
|
||||
-> Cornice p a c
|
||||
-> AnnotatedCornice p a c
|
||||
-> Cornice Headed p a c
|
||||
-> AnnotatedCornice (Maybe Int) p a c
|
||||
annotateFinely g finish toSize xs cornice = runST $ do
|
||||
m <- newMutableSizedCornice cornice
|
||||
sizeColonnades toSize xs m
|
||||
@ -352,16 +356,18 @@ freezeMutableSizedCornice :: forall s p a c.
|
||||
(Int -> Int -> Int) -- ^ fold function
|
||||
-> (Int -> Int) -- ^ finalize
|
||||
-> MutableSizedCornice s p a c
|
||||
-> ST s (AnnotatedCornice p a c)
|
||||
-> ST s (AnnotatedCornice (Maybe Int) p a c)
|
||||
freezeMutableSizedCornice step finish = go
|
||||
where
|
||||
go :: forall p' a' c'. MutableSizedCornice s p' a' c' -> ST s (AnnotatedCornice p' a' c')
|
||||
go :: forall p' a' c'.
|
||||
MutableSizedCornice s p' a' c'
|
||||
-> ST s (AnnotatedCornice (Maybe Int) p' a' c')
|
||||
go (MutableSizedCorniceBase msc) = do
|
||||
szCol <- freezeMutableSizedColonnade msc
|
||||
let sz =
|
||||
( mapJustInt finish
|
||||
. V.foldl' (combineJustInt step) Nothing
|
||||
. V.map (Just . sizedSize . oneColonnadeHead)
|
||||
. V.map (sizedSize . oneColonnadeHead)
|
||||
) (getColonnade szCol)
|
||||
return (AnnotatedCorniceBase sz szCol)
|
||||
go (MutableSizedCorniceCap v1) = do
|
||||
@ -374,10 +380,10 @@ freezeMutableSizedCornice step finish = go
|
||||
return $ AnnotatedCorniceCap sz v2
|
||||
|
||||
newMutableSizedCornice :: forall s p a c.
|
||||
Cornice p a c
|
||||
Cornice Headed p a c
|
||||
-> ST s (MutableSizedCornice s p a c)
|
||||
newMutableSizedCornice = go where
|
||||
go :: forall p'. Cornice p' a c -> ST s (MutableSizedCornice s p' a c)
|
||||
go :: forall p'. Cornice Headed p' a c -> ST s (MutableSizedCornice s p' a c)
|
||||
go (CorniceBase c) = fmap MutableSizedCorniceBase (newMutableSizedColonnade c)
|
||||
go (CorniceCap v) = fmap MutableSizedCorniceCap (V.mapM (traverseOneCorniceBody go) v)
|
||||
|
||||
@ -390,7 +396,7 @@ mapHeadedness f (Colonnade v) =
|
||||
|
||||
|
||||
-- | This is an O(1) operation, sort of
|
||||
size :: AnnotatedCornice p a c -> Maybe Int
|
||||
size :: AnnotatedCornice sz p a c -> sz
|
||||
size x = case x of
|
||||
AnnotatedCorniceBase m _ -> m
|
||||
AnnotatedCorniceCap sz _ -> sz
|
||||
@ -401,15 +407,15 @@ 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 r m c p a.
|
||||
headersMonoidal :: forall sz r m c p a.
|
||||
Monoid m
|
||||
=> Maybe (Fascia p r, r -> m -> m) -- ^ Apply the Fascia header row content
|
||||
-> [(Int -> c -> m, m -> m)] -- ^ Build content from cell content and size
|
||||
-> AnnotatedCornice p a c
|
||||
-> [(sz -> c -> m, m -> m)] -- ^ Build content from cell content and size
|
||||
-> AnnotatedCornice sz p a c
|
||||
-> m
|
||||
headersMonoidal wrapRow fromContentList = go wrapRow
|
||||
where
|
||||
go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice p' a c -> m
|
||||
go :: forall p'. Maybe (Fascia p' r, r -> m -> m) -> AnnotatedCornice sz p' a c -> m
|
||||
go ef (AnnotatedCorniceBase _ (Colonnade v)) =
|
||||
let g :: m -> m
|
||||
g m = case ef of
|
||||
@ -424,10 +430,7 @@ headersMonoidal wrapRow fromContentList = go wrapRow
|
||||
Nothing -> m
|
||||
Just (FasciaCap r _, f) -> f r m
|
||||
in g (foldMap (\(fromContent,wrap) -> wrap (foldMap (\(OneCornice h b) ->
|
||||
(case size b of
|
||||
Nothing -> mempty
|
||||
Just sz -> fromContent sz h)
|
||||
) v)) fromContentList)
|
||||
(fromContent (size b) h)) v)) fromContentList)
|
||||
<> case ef of
|
||||
Nothing -> case flattenAnnotated v of
|
||||
Nothing -> mempty
|
||||
@ -436,23 +439,33 @@ headersMonoidal wrapRow fromContentList = go wrapRow
|
||||
Nothing -> mempty
|
||||
Just annCoreNext -> go (Just (fn,f)) annCoreNext
|
||||
|
||||
flattenAnnotated :: Vector (OneCornice AnnotatedCornice p a c) -> Maybe (AnnotatedCornice p a c)
|
||||
flattenAnnotated ::
|
||||
Vector (OneCornice (AnnotatedCornice sz) p a c)
|
||||
-> Maybe (AnnotatedCornice sz p a c)
|
||||
flattenAnnotated v = case v V.!? 0 of
|
||||
Nothing -> Nothing
|
||||
Just (OneCornice _ x) -> Just $ case x of
|
||||
AnnotatedCorniceBase m _ -> flattenAnnotatedBase m v
|
||||
AnnotatedCorniceCap m _ -> flattenAnnotatedCap m v
|
||||
|
||||
flattenAnnotatedBase :: Maybe Int -> Vector (OneCornice AnnotatedCornice Base a c) -> AnnotatedCornice Base a c
|
||||
flattenAnnotatedBase ::
|
||||
sz
|
||||
-> Vector (OneCornice (AnnotatedCornice sz) Base a c)
|
||||
-> AnnotatedCornice sz Base a c
|
||||
flattenAnnotatedBase msz = AnnotatedCorniceBase msz
|
||||
. Colonnade
|
||||
. V.concatMap
|
||||
(\(OneCornice _ (AnnotatedCorniceBase _ (Colonnade v))) -> v)
|
||||
|
||||
flattenAnnotatedCap :: Maybe Int -> Vector (OneCornice AnnotatedCornice (Cap p) a c) -> AnnotatedCornice (Cap p) a c
|
||||
flattenAnnotatedCap ::
|
||||
sz
|
||||
-> Vector (OneCornice (AnnotatedCornice sz) (Cap p) a c)
|
||||
-> AnnotatedCornice sz (Cap p) a c
|
||||
flattenAnnotatedCap m = AnnotatedCorniceCap m . V.concatMap getTheVector
|
||||
|
||||
getTheVector :: OneCornice AnnotatedCornice (Cap p) a c -> Vector (OneCornice AnnotatedCornice p a c)
|
||||
getTheVector ::
|
||||
OneCornice (AnnotatedCornice sz) (Cap p) a c
|
||||
-> Vector (OneCornice (AnnotatedCornice sz) p a c)
|
||||
getTheVector (OneCornice _ (AnnotatedCorniceCap _ v)) = v
|
||||
|
||||
data MutableSizedCornice s (p :: Pillar) a c where
|
||||
@ -492,8 +505,8 @@ newtype Headed a = Headed { getHeaded :: a }
|
||||
data Headless a = Headless
|
||||
deriving (Eq,Ord,Functor,Show,Read,Foldable)
|
||||
|
||||
data Sized f a = Sized
|
||||
{ sizedSize :: {-# UNPACK #-} !Int
|
||||
data Sized sz f a = Sized
|
||||
{ sizedSize :: !sz
|
||||
, sizedContent :: !(f a)
|
||||
} deriving (Functor, Foldable)
|
||||
|
||||
@ -554,7 +567,7 @@ instance Semigroup (Colonnade h a c) where
|
||||
data Pillar = Cap !Pillar | Base
|
||||
|
||||
class ToEmptyCornice (p :: Pillar) where
|
||||
toEmptyCornice :: Cornice p a c
|
||||
toEmptyCornice :: Cornice h p a c
|
||||
|
||||
instance ToEmptyCornice Base where
|
||||
toEmptyCornice = CorniceBase mempty
|
||||
@ -571,36 +584,39 @@ data OneCornice k (p :: Pillar) a c = OneCornice
|
||||
, oneCorniceBody :: !(k p a c)
|
||||
}
|
||||
|
||||
data Cornice (p :: Pillar) a c where
|
||||
CorniceBase :: !(Colonnade Headed a c) -> Cornice Base a c
|
||||
CorniceCap :: {-# UNPACK #-} !(Vector (OneCornice Cornice p a c)) -> Cornice (Cap p) a c
|
||||
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 Semigroup (Cornice p a c) where
|
||||
instance Semigroup (Cornice h p a c) where
|
||||
CorniceBase a <> CorniceBase b = CorniceBase (mappend a b)
|
||||
CorniceCap a <> CorniceCap b = CorniceCap (a Vector.++ b)
|
||||
sconcat xs@(x :| _) = case x of
|
||||
CorniceBase _ -> CorniceBase (Colonnade (vectorConcatNE (fmap (getColonnade . getCorniceBase) xs)))
|
||||
CorniceCap _ -> CorniceCap (vectorConcatNE (fmap getCorniceCap xs))
|
||||
|
||||
instance ToEmptyCornice p => Monoid (Cornice p a c) where
|
||||
instance ToEmptyCornice p => Monoid (Cornice h p a c) where
|
||||
mempty = toEmptyCornice
|
||||
mappend = (Semigroup.<>)
|
||||
mconcat xs1 = case xs1 of
|
||||
[] -> toEmptyCornice
|
||||
x : xs2 -> Semigroup.sconcat (x :| xs2)
|
||||
|
||||
getCorniceBase :: Cornice Base a c -> Colonnade Headed a c
|
||||
getCorniceBase :: Cornice h Base a c -> Colonnade h a c
|
||||
getCorniceBase (CorniceBase c) = c
|
||||
|
||||
getCorniceCap :: Cornice (Cap p) a c -> Vector (OneCornice Cornice p a c)
|
||||
getCorniceCap :: Cornice h (Cap p) a c -> Vector (OneCornice (Cornice h) p a c)
|
||||
getCorniceCap (CorniceCap c) = c
|
||||
|
||||
data AnnotatedCornice (p :: Pillar) a c where
|
||||
AnnotatedCorniceBase :: !(Maybe Int) -> !(Colonnade (Sized Headed) a c) -> AnnotatedCornice Base a c
|
||||
data AnnotatedCornice sz (p :: Pillar) a c where
|
||||
AnnotatedCorniceBase ::
|
||||
!sz
|
||||
-> !(Colonnade (Sized sz Headed) a c)
|
||||
-> AnnotatedCornice sz Base a c
|
||||
AnnotatedCorniceCap ::
|
||||
!(Maybe Int)
|
||||
-> {-# UNPACK #-} !(Vector (OneCornice AnnotatedCornice p a c))
|
||||
-> AnnotatedCornice (Cap p) a c
|
||||
!sz
|
||||
-> {-# UNPACK #-} !(Vector (OneCornice (AnnotatedCornice sz) p a c))
|
||||
-> AnnotatedCornice sz (Cap p) a c
|
||||
|
||||
-- data MaybeInt = JustInt {-# UNPACK #-} !Int | NothingInt
|
||||
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
@ -11,10 +14,12 @@ module Reflex.Dom.Colonnade
|
||||
(
|
||||
-- * Types
|
||||
Cell(..)
|
||||
, Resizable(..)
|
||||
-- * Table Encoders
|
||||
, basic
|
||||
, static
|
||||
, capped
|
||||
, cappedResizable
|
||||
, cappedTraversing
|
||||
, dynamic
|
||||
, dynamicCapped
|
||||
@ -35,12 +40,16 @@ 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 Data.Map.Strict (Map)
|
||||
import Data.Text (Text)
|
||||
import Data.Foldable (Foldable(..),for_,forM_)
|
||||
import Data.Traversable (for)
|
||||
import Data.Semigroup (Semigroup(..))
|
||||
import Control.Applicative (liftA2)
|
||||
import Reflex.Dom
|
||||
import Colonnade (Colonnade,Headed,Fascia,Cornice)
|
||||
import Data.Monoid (Sum(..))
|
||||
import qualified Colonnade as C
|
||||
import qualified Colonnade.Encode as E
|
||||
|
||||
data Cell t m b = Cell
|
||||
@ -48,6 +57,13 @@ data Cell t m b = Cell
|
||||
, cellContents :: !(m b)
|
||||
} deriving (Functor)
|
||||
|
||||
-- | In practice, this size will only ever be set to zero
|
||||
-- or one.
|
||||
data Resizable t h b = Resizable
|
||||
{ resizableSize :: !(Dynamic t Int)
|
||||
, resizableContent :: !(h b)
|
||||
}
|
||||
|
||||
elFromCell :: (DomBuilder t m, PostBuild t m) => T.Text -> Cell t m b -> m b
|
||||
elFromCell e (Cell attr m) = elDynAttr e attr m
|
||||
|
||||
@ -99,7 +115,7 @@ basic tableAttrs = static tableAttrs (Just (M.empty,M.empty)) mempty (const memp
|
||||
body :: (DomBuilder t m, PostBuild t m, Foldable f, Monoid e)
|
||||
=> M.Map T.Text T.Text
|
||||
-> (a -> M.Map T.Text T.Text)
|
||||
-> Colonnade p a (Cell t m e)
|
||||
-> Colonnade h a (Cell t m e)
|
||||
-> f a
|
||||
-> m e
|
||||
body bodyAttrs trAttrs colonnade collection =
|
||||
@ -117,6 +133,19 @@ 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)
|
||||
-> f a
|
||||
-> m e
|
||||
bodyResizable bodyAttrs trAttrs colonnade collection = elAttr "tbody" bodyAttrs $ do
|
||||
unWrappedApplicative . flip foldMap collection $ \a -> WrappedApplicative
|
||||
$ elAttr "tr" (trAttrs a)
|
||||
$ unWrappedApplicative
|
||||
$ E.rowMonoidalHeader colonnade (\(Resizable dynSize _) (Cell cattr content) ->
|
||||
WrappedApplicative (elDynAttr "td" (zipDynWith (\i at -> M.insert "colspan" (T.pack (show i)) at) dynSize cattr) content)) a
|
||||
|
||||
static ::
|
||||
(DomBuilder t m, PostBuild t m, Foldable f, Foldable h, Monoid e)
|
||||
=> M.Map T.Text T.Text -- ^ @\<table\>@ tag attributes
|
||||
@ -160,10 +189,10 @@ sectioned tableAttrs mheadAttrs bodyAttrs trAttrs dividerContent colonnade@(E.Co
|
||||
bodyRows trAttrs colonnade as
|
||||
|
||||
encodeCorniceHead ::
|
||||
(DomBuilder t m, PostBuild t m, Monoid e)
|
||||
(DomBuilder t m, PostBuild t m, Monoid e)
|
||||
=> M.Map T.Text T.Text
|
||||
-> Fascia p (M.Map T.Text T.Text)
|
||||
-> E.AnnotatedCornice p a (Cell t m e)
|
||||
-> E.AnnotatedCornice (Maybe Int) p a (Cell t m e)
|
||||
-> m e
|
||||
encodeCorniceHead headAttrs fascia annCornice =
|
||||
elAttr "thead" headAttrs (unWrappedApplicative thead)
|
||||
@ -172,14 +201,33 @@ encodeCorniceHead headAttrs fascia annCornice =
|
||||
where addColspan = M.insert "colspan" (T.pack (show size))
|
||||
addAttr attrs = WrappedApplicative . elAttr "tr" attrs . unWrappedApplicative
|
||||
|
||||
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)
|
||||
-> m e
|
||||
encodeCorniceResizableHead headAttrs fascia annCornice =
|
||||
elAttr "thead" headAttrs (unWrappedApplicative thead)
|
||||
where
|
||||
thead :: WrappedApplicative m e
|
||||
thead = E.headersMonoidal (Just (fascia, addAttr)) [(th,id)] annCornice
|
||||
th :: Dynamic t Int -> Cell t m e -> WrappedApplicative m e
|
||||
th size (Cell attrs contents) = WrappedApplicative (elDynAttr "th" (zipDynWith addColspan size attrs) contents)
|
||||
where
|
||||
addColspan :: Int -> Map Text Text -> Map Text Text
|
||||
addColspan i = M.insert "colspan" (T.pack (show i))
|
||||
addAttr :: Map Text Text -> WrappedApplicative m b -> WrappedApplicative m b
|
||||
addAttr attrs = WrappedApplicative . elAttr "tr" attrs . unWrappedApplicative
|
||||
|
||||
capped ::
|
||||
(DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e)
|
||||
(DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e)
|
||||
=> M.Map T.Text T.Text -- ^ @\<table\>@ tag attributes
|
||||
-> M.Map T.Text T.Text -- ^ @\<thead\>@ tag attributes
|
||||
-> M.Map T.Text T.Text -- ^ @\<tbody\>@ tag attributes
|
||||
-> (a -> M.Map T.Text T.Text) -- ^ @\<tr\>@ tag attributes
|
||||
-> Fascia p (M.Map T.Text T.Text) -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
|
||||
-> Cornice p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> Cornice Headed p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> f a -- ^ Collection of data
|
||||
-> m e
|
||||
capped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
||||
@ -188,6 +236,42 @@ capped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
||||
b <- body bodyAttrs trAttrs (E.discard cornice) collection
|
||||
return (h `mappend` b)
|
||||
|
||||
cappedResizable ::
|
||||
(DomBuilder t m, PostBuild t m, MonadHold t m, Foldable f, Monoid e)
|
||||
=> Map Text Text -- ^ @\<table\>@ tag attributes
|
||||
-> Map Text Text -- ^ @\<thead\>@ tag attributes
|
||||
-> Map Text Text -- ^ @\<tbody\>@ tag attributes
|
||||
-> (a -> Map Text Text) -- ^ @\<tr\>@ tag attributes
|
||||
-> Fascia p (Map Text Text) -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
|
||||
-> Cornice (Resizable t Headed) p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> f a -- ^ Collection of data
|
||||
-> m e
|
||||
cappedResizable tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection = do
|
||||
elAttr "table" tableAttrs $ do
|
||||
h <- encodeCorniceResizableHead headAttrs fascia (dynamicAnnotate cornice)
|
||||
b <- bodyResizable bodyAttrs trAttrs (E.discard cornice) collection
|
||||
return (h `mappend` b)
|
||||
|
||||
dynamicAnnotate :: Reflex t
|
||||
=> Cornice (Resizable t Headed) p a c
|
||||
-> E.AnnotatedCornice (Dynamic t Int) 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
|
||||
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
|
||||
in E.AnnotatedCorniceBase (coerceDynamic parentSz) (C.mapHeadedness (\(Resizable dynSize (E.Headed content)) -> E.Sized dynSize (E.Headed content)) 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)
|
||||
|
||||
bodyTraversing :: (DomBuilder t m, PostBuild t m, Traversable f, Monoid e)
|
||||
=> M.Map T.Text T.Text
|
||||
-> (a -> M.Map T.Text T.Text)
|
||||
@ -207,7 +291,7 @@ cappedTraversing ::
|
||||
-> M.Map T.Text T.Text -- ^ @\<tbody\>@ tag attributes
|
||||
-> (a -> M.Map T.Text T.Text) -- ^ @\<tr\>@ tag attributes
|
||||
-> Fascia p (M.Map T.Text T.Text) -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
|
||||
-> Cornice p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> Cornice Headed p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> f a -- ^ Collection of data
|
||||
-> m (f e)
|
||||
cappedTraversing tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
||||
@ -251,7 +335,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 p a (Cell t m e)
|
||||
-> E.AnnotatedCornice (Maybe Int) p a (Cell t m e)
|
||||
-> m e
|
||||
encodeCorniceHeadDynamic headAttrs fascia annCornice =
|
||||
elDynAttr "thead" headAttrs (unWrappedApplicative thead)
|
||||
@ -267,7 +351,7 @@ dynamicCapped ::
|
||||
-> Dynamic t (M.Map T.Text T.Text) -- ^ @\<tbody\>@ tag attributes
|
||||
-> (a -> M.Map T.Text T.Text) -- ^ @\<tr\>@ tag attributes
|
||||
-> Fascia p (Dynamic t (M.Map T.Text T.Text)) -- ^ Attributes for @\<tr\>@ elements in the @\<thead\>@
|
||||
-> Cornice p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> Cornice Headed p a (Cell t m e) -- ^ Data encoding strategy
|
||||
-> Dynamic t (f a) -- ^ Collection of data
|
||||
-> m (Event t e)
|
||||
dynamicCapped tableAttrs headAttrs bodyAttrs trAttrs fascia cornice collection =
|
||||
|
||||
@ -40,7 +40,7 @@ packages:
|
||||
- 'yesod-colonnade'
|
||||
- 'blaze-colonnade'
|
||||
- 'siphon'
|
||||
- 'geolite-csv'
|
||||
# - 'geolite-csv'
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||
# (e.g., acme-missiles-0.3)
|
||||
extra-deps:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user