mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
add inter-row stuff
This commit is contained in:
parent
70de308253
commit
c752a34382
@ -1,5 +1,5 @@
|
||||
name: colonnade
|
||||
version: 0.4
|
||||
version: 0.4.1
|
||||
synopsis: Generic types and functions for columnar encoding and decoding
|
||||
description: Please see README.md
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
|
@ -2,7 +2,9 @@ module Colonnade.Encoding where
|
||||
|
||||
import Colonnade.Types
|
||||
import Data.Vector (Vector)
|
||||
import Data.Foldable
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Colonnade.Internal as Internal
|
||||
|
||||
mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a
|
||||
mapContent f (Encoding v) = Encoding
|
||||
@ -29,10 +31,25 @@ runRowMonadic :: (Monad m, Monoid b)
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
runRowMonadic (Encoding v) g a = fmap (mconcat . Vector.toList)
|
||||
$ Vector.forM v
|
||||
runRowMonadic (Encoding v) g a =
|
||||
-- fmap (mconcat . Vector.toList)
|
||||
-- $ Vector.forM v
|
||||
flip Internal.foldMapM v
|
||||
$ \e -> g (oneEncodingEncode e a)
|
||||
|
||||
runRowMonadicWith :: (Monad m)
|
||||
=> b
|
||||
-> (b -> b -> b)
|
||||
-> Encoding f content a
|
||||
-> (content -> m b)
|
||||
-> a
|
||||
-> m b
|
||||
runRowMonadicWith bempty bappend (Encoding v) g a =
|
||||
foldrM (\e br -> do
|
||||
bl <- g (oneEncodingEncode e a)
|
||||
return (bappend bl br)
|
||||
) bempty v
|
||||
|
||||
runHeader :: (c1 -> c2) -> Encoding Headed c1 a -> Vector c2
|
||||
runHeader g (Encoding v) =
|
||||
Vector.map (g . getHeaded . oneEncodingHead) v
|
||||
@ -44,14 +61,23 @@ runHeaderMonadic :: (Monad m, Monoid b)
|
||||
runHeaderMonadic (Encoding v) g =
|
||||
fmap (mconcat . Vector.toList) $ Vector.mapM (g . getHeaded . oneEncodingHead) v
|
||||
|
||||
runHeaderMonadic_ ::
|
||||
(Monad m)
|
||||
=> Encoding Headed content a
|
||||
-> (content -> m b)
|
||||
-> m ()
|
||||
runHeaderMonadic_ (Encoding v) g = Vector.mapM_ (g . getHeaded . oneEncodingHead) v
|
||||
|
||||
fromMaybe :: c -> Encoding f c a -> Encoding f c (Maybe a)
|
||||
fromMaybe c (Encoding v) = Encoding $ flip Vector.map v $
|
||||
\(OneEncoding h encode) -> OneEncoding h (maybe c encode)
|
||||
|
||||
columns :: (b -> a -> c)
|
||||
-> (b -> f c)
|
||||
-> Vector b
|
||||
-> (b -> f c)
|
||||
-> Vector b
|
||||
-> Encoding f c a
|
||||
columns getCell getHeader bs =
|
||||
Encoding $ Vector.map (\b -> OneEncoding (getHeader b) (getCell b)) bs
|
||||
|
||||
|
||||
|
||||
|
@ -1,6 +1,8 @@
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
module Colonnade.Internal where
|
||||
|
||||
import Data.Foldable (foldrM)
|
||||
|
||||
newtype EitherWrap a b = EitherWrap
|
||||
{ getEitherWrap :: Either a b
|
||||
} deriving (Functor)
|
||||
@ -15,3 +17,7 @@ instance Monoid a => Applicative (EitherWrap a) where
|
||||
mapLeft :: (a -> b) -> Either a c -> Either b c
|
||||
mapLeft _ (Right a) = Right a
|
||||
mapLeft f (Left a) = Left (f a)
|
||||
|
||||
foldMapM :: (Foldable t, Monoid b, Monad m) => (a -> m b) -> t a -> m b
|
||||
foldMapM f = foldrM (\a b -> fmap (flip mappend b) (f a)) mempty
|
||||
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: reflex-dom-colonnade
|
||||
version: 0.4
|
||||
version: 0.4.1
|
||||
synopsis: Use colonnade with reflex-dom
|
||||
description: Please see README.md
|
||||
homepage: https://github.com/andrewthad/colonnade#readme
|
||||
@ -18,7 +18,7 @@ library
|
||||
Reflex.Dom.Colonnade
|
||||
build-depends:
|
||||
base >= 4.7 && < 5
|
||||
, colonnade >= 0.3
|
||||
, colonnade >= 0.4.1
|
||||
, contravariant
|
||||
, vector
|
||||
, reflex
|
||||
|
@ -10,13 +10,15 @@ module Reflex.Dom.Colonnade
|
||||
|
||||
import Colonnade.Types
|
||||
import Control.Monad
|
||||
import Data.Maybe
|
||||
import Data.Foldable
|
||||
import Reflex (Dynamic,Event,switchPromptly,never)
|
||||
import Reflex (Dynamic,Event,switchPromptly,never,leftmost)
|
||||
import Reflex.Dynamic (mapDyn)
|
||||
import Reflex.Dom (MonadWidget)
|
||||
import Reflex.Dom.Widget.Basic
|
||||
import Data.Map (Map)
|
||||
import Data.Semigroup (Semigroup)
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Colonnade.Encoding as Encoding
|
||||
import qualified Data.Map as Map
|
||||
|
||||
@ -44,6 +46,33 @@ basic tableAttrs as encoding = do
|
||||
el "tbody" $ forM_ as $ \a -> do
|
||||
el "tr" $ Encoding.runRowMonadic encoding (elFromCell "td") a
|
||||
|
||||
interRowContent :: (MonadWidget t m, Foldable f)
|
||||
=> String
|
||||
-> String
|
||||
-> f a
|
||||
-> Encoding Headed (Cell m (Event t (Maybe (m ())))) a
|
||||
-> m ()
|
||||
interRowContent tableClass tdExtraClass as encoding@(Encoding v) = do
|
||||
let vlen = Vector.length v
|
||||
elAttr "table" (Map.singleton "class" tableClass) $ do
|
||||
-- Discarding this result is technically the wrong thing
|
||||
-- to do, but I cannot imagine why anyone would want to
|
||||
-- drop down content under the heading.
|
||||
_ <- theadBuild_ encoding
|
||||
el "tbody" $ forM_ as $ \a -> do
|
||||
e' <- el "tr" $ do
|
||||
e <- Encoding.runRowMonadicWith never const encoding (elFromCell "td") a
|
||||
let e' = flip fmap e $ \mwidg -> case mwidg of
|
||||
Nothing -> return ()
|
||||
Just widg -> el "tr" $ do
|
||||
elAttr "td" ( Map.fromList
|
||||
[ ("class",tdExtraClass)
|
||||
, ("colspan",show vlen)
|
||||
]
|
||||
) widg
|
||||
return e'
|
||||
widgetHold (return ()) e'
|
||||
|
||||
elFromCell :: MonadWidget t m => String -> Cell m b -> m b
|
||||
elFromCell name (Cell attrs contents) = elAttr name attrs contents
|
||||
|
||||
@ -51,6 +80,10 @@ theadBuild :: (MonadWidget t m, Monoid b) => Encoding Headed (Cell m b) a -> m b
|
||||
theadBuild encoding = el "thead" . el "tr"
|
||||
$ Encoding.runHeaderMonadic encoding (elFromCell "th")
|
||||
|
||||
theadBuild_ :: (MonadWidget t m) => Encoding Headed (Cell m b) a -> m ()
|
||||
theadBuild_ encoding = el "thead" . el "tr"
|
||||
$ Encoding.runHeaderMonadic_ encoding (elFromCell "th")
|
||||
|
||||
dynamic :: (MonadWidget t m, Foldable f)
|
||||
=> Map String String -- ^ Table element attributes
|
||||
-> f (Dynamic t a) -- ^ Dynamic values
|
||||
|
Loading…
Reference in New Issue
Block a user