diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal index be99a16..012f334 100644 --- a/colonnade/colonnade.cabal +++ b/colonnade/colonnade.cabal @@ -19,7 +19,7 @@ library Colonnade.Encoding Colonnade.Decoding Colonnade.Internal.Ap - build-depends: + build-depends: base >= 4.7 && < 5 , contravariant , vector diff --git a/colonnade/src/Colonnade/Decoding.hs b/colonnade/src/Colonnade/Decoding.hs index f770540..d4c8f36 100644 --- a/colonnade/src/Colonnade/Decoding.hs +++ b/colonnade/src/Colonnade/Decoding.hs @@ -9,7 +9,7 @@ import Data.Functor.Contravariant -- constraint means that @f@ can be 'Headless' but not 'Headed'. contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decoding f c1 a -> Decoding f c2 a contramapContent f = go - where + where go :: forall b. Decoding f c1 b -> Decoding f c2 b go (DecodingPure x) = DecodingPure x go (DecodingAp h decode apNext) = diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs index 06738a5..d62739f 100644 --- a/colonnade/src/Colonnade/Encoding.hs +++ b/colonnade/src/Colonnade/Encoding.hs @@ -4,7 +4,7 @@ import Colonnade.Types import qualified Data.Vector as Vector mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a -mapContent f (Encoding v) = Encoding +mapContent f (Encoding v) = Encoding $ Vector.map (\(h,c) -> (fmap f h,f . c)) v headless :: (a -> content) -> Encoding Headless content a diff --git a/colonnade/src/Colonnade/Types.hs b/colonnade/src/Colonnade/Types.hs index 94d96b2..7d157d6 100644 --- a/colonnade/src/Colonnade/Types.hs +++ b/colonnade/src/Colonnade/Types.hs @@ -28,10 +28,10 @@ instance Contravariant Headless where -- Check out @Control.Applicative.Free@ in the @free@ library to -- learn more about this. data Decoding f content a where - DecodingPure :: !a + DecodingPure :: !a -> Decoding f content a DecodingAp :: !(f content) - -> !(content -> Either String a) + -> !(content -> Either String a) -> !(Decoding f content (a -> b)) -> Decoding f content b @@ -44,17 +44,17 @@ instance Applicative (Decoding f content) where DecodingPure f <*> y = fmap f y DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z) -newtype Encoding f content a = Encoding +newtype Encoding f content a = Encoding { getEncoding :: Vector (f content,a -> content) } deriving (Monoid) instance Contravariant (Encoding f content) where - contramap f (Encoding v) = Encoding + contramap f (Encoding v) = Encoding (Vector.map (\(h,c) -> (h, c . f)) v) instance Divisible (Encoding f content) where conquer = Encoding Vector.empty - divide f (Encoding a) (Encoding b) = + divide f (Encoding a) (Encoding b) = Encoding $ (Vector.++) (Vector.map (\(h,c) -> (h,c . fst . f)) a) (Vector.map (\(h,c) -> (h,c . snd . f)) b) diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal index 971df63..2ba7853 100644 --- a/reflex-dom-colonnade/reflex-dom-colonnade.cabal +++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal @@ -16,12 +16,14 @@ library hs-source-dirs: src exposed-modules: Reflex.Dom.Colonnade - build-depends: + build-depends: base >= 4.7 && < 5 , colonnade , contravariant , vector + , reflex , reflex-dom + , containers default-language: Haskell2010 source-repository head diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs index ef79ece..5d6d7e6 100644 --- a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs +++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs @@ -1,15 +1,50 @@ module Reflex.Dom.Colonnade where import Colonnade.Types +import Control.Monad +import Reflex (Dynamic) +import Reflex.Dynamic (mapDyn) +import Reflex.Dom (MonadWidget) import Reflex.Dom.Widget.Basic +import Data.Map (Map) +import qualified Data.Map as Map --- hmm... --- data WithAttrs +cell :: m () -> Cell m +cell = Cell Map.empty -basic :: MonadWidget t m - => Encoding Headed (m ()) Int +data Cell m = Cell + { cellAttrs :: Map String String + , cellContents :: m () + } + +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 -> m () -basic (Encoding v) = do - el "table" $ do - el "thead" $ mapM_ (getHeaded . fst) v +basic tableAttrs as (Encoding v) = do + elAttr "table" tableAttrs $ do + el "thead" $ forM_ v $ \(Headed (Cell attrs contents),_) -> + elAttr "th" attrs contents + el "tbody" $ forM_ as $ \a -> do + el "tr" $ forM_ v $ \(_,encode) -> do + let Cell attrs contents = encode a + elAttr "td" attrs contents + +dynamic :: (MonadWidget t m, Foldable f) + => Map String String -- ^ Table element attributes + -> f (Dynamic t a) -- ^ Dynamic values + -> Encoding Headed (Cell m) a -- ^ Encoding of a value into cells + -> m () +dynamic tableAttrs as (Encoding v) = do + elAttr "table" tableAttrs $ do + el "thead" $ forM_ v $ \(Headed (Cell attrs contents),_) -> + elAttr "th" attrs contents + el "tbody" $ forM_ as $ \a -> do + el "tr" $ forM_ v $ \(_,encode) -> do + dynPair <- mapDyn encode a + dynAttrs <- mapDyn cellAttrs dynPair + dynContent <- mapDyn cellContents dynPair + _ <- elDynAttr "td" dynAttrs $ dyn dynContent + return ()