reflex-dom-colonnade 0.4.4 → 0.4.6
raw patch · 2 files changed
+71/−16 lines, 2 filesdep +textdep ~basedep ~colonnadedep ~containers
Dependencies added: text
Dependency ranges changed: base, colonnade, containers, contravariant, semigroups, vector
Files
reflex-dom-colonnade.cabal view
@@ -1,5 +1,5 @@ name: reflex-dom-colonnade-version: 0.4.4+version: 0.4.6 synopsis: Use colonnade with reflex-dom description: Please see README.md homepage: https://github.com/andrewthad/colonnade#readme@@ -17,14 +17,15 @@ exposed-modules: Reflex.Dom.Colonnade build-depends:- base >= 4.7 && < 5- , colonnade >= 0.4.4- , contravariant- , vector+ base >= 4.7 && < 5.0+ , colonnade >= 0.4.6 && < 0.5+ , contravariant >= 1.2 && < 1.5+ , vector >= 0.10 && < 0.12+ , text >= 1.0 && < 1.3 , reflex , reflex-dom- , containers- , semigroups+ , containers >= 0.5 && < 0.6+ , semigroups >= 0.16 && < 0.19 default-language: Haskell2010 ghc-options: -Wall
src/Reflex/Dom/Colonnade.hs view
@@ -1,12 +1,22 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Reflex.Dom.Colonnade- ( Cell(..)- , cell+ (+ -- * Types+ Cell(..)+ -- * Table Encoders , basic , dynamic , dynamicEventful , expandable+ , listItems+ -- * Cell Functions+ , cell+ , stringCell+ , textCell+ , builderCell ) where import Colonnade.Types@@ -19,15 +29,29 @@ import Reflex.Dom.Widget.Basic import Data.Map (Map) import Data.Semigroup (Semigroup)+import Data.Text (Text)+import Data.String (IsString(..)) import qualified Data.Vector as Vector import qualified Colonnade.Encoding as Encoding import qualified Data.Map as Map+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LText+import qualified Data.Text.Lazy.Builder as TBuilder -- | Convenience function for creating a 'Cell' representing -- a @td@ or @th@ with no attributes. cell :: m b -> Cell m b cell = Cell Map.empty +stringCell :: MonadWidget t m => String -> Cell m ()+stringCell = cell . text++textCell :: MonadWidget t m => Text -> Cell m ()+textCell = cell . text . Text.unpack++builderCell :: MonadWidget t m => TBuilder.Builder -> Cell m ()+builderCell = textCell . LText.toStrict . TBuilder.toLazyText+ -- data NewCell b = NewCell -- { newCellAttrs :: !(Map String String) -- , newCellContents :: !b@@ -38,13 +62,41 @@ , cellContents :: !(m b) } deriving (Functor) +-- | This instance is requires @UndecidableInstances@ and is kind of+-- bad, but @reflex@ already abusing type classes so much that it+-- doesn\'t seem too terrible to add this to the mix.+instance (MonadWidget t m, a ~ ()) => IsString (Cell m a) where+ fromString = stringCell++-- | This determines the attributes that are added+-- to the individual @li@s by concatenating the header\'s+-- attributes with the data\'s attributes.+listItems :: (Foldable f, MonadWidget t m)+ => (m () -> m ())+ -- ^ Wrapper for items, often @ul@+ -> (m () -> m () -> m ())+ -- ^ Combines header with data+ -> Encoding Headed (Cell m ()) a+ -- ^ How to encode data as a row+ -> f a+ -- ^ Rows of data+ -> m ()+listItems ulWrap combine enc xs =+ forM_ xs $ ulWrap . Encoding.runBothMonadic_ enc+ (\(Cell ha hc) (Cell ba bc) ->+ -- Consider doing something better than union for+ -- combining the two maps. For example, what if they+ -- both have a class.+ elAttr "li" (Map.union ha ba) (combine hc bc)+ )+ -- | A static table basic :: (MonadWidget t m, Foldable f) => Map String String -- ^ Table element attributes- -> f a -- ^ Values -> Encoding Headed (Cell m ()) a -- ^ Encoding of a value into cells+ -> f a -- ^ Values -> m ()-basic tableAttrs as encoding = do+basic tableAttrs encoding as = do elAttr "table" tableAttrs $ do theadBuild encoding el "tbody" $ forM_ as $ \a -> do@@ -53,10 +105,11 @@ -- | Table with cells that can create expanded content -- between the rows. expandable :: (MonadWidget t m, Foldable f)- => String- -> String- -> f a+ => String -- ^ Table class+ -> String -- ^ Class of expanded table rows+ -> f a -- ^ Values -> Encoding Headed (Cell m (Event t (Maybe (m ())))) a+ -- ^ Encoding into cells with events that can fire to create additional content under the row -> m () expandable tableClass tdExtraClass as encoding@(Encoding v) = do let vlen = Vector.length v@@ -67,8 +120,9 @@ _ <- 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+ elist <- Encoding.runRowMonadicWith [] (++) encoding (fmap (\a -> [a]) . elFromCell "td") a+ let e = leftmost elist+ e' = flip fmap e $ \mwidg -> case mwidg of Nothing -> return () Just widg -> el "tr" $ do elAttr "td" ( Map.fromList