strip trailing spaces. add more features

This commit is contained in:
Andrew Martin 2016-06-22 14:41:56 -04:00
parent dc71d30438
commit 189c95f7fe
6 changed files with 53 additions and 16 deletions

View File

@ -19,7 +19,7 @@ library
Colonnade.Encoding Colonnade.Encoding
Colonnade.Decoding Colonnade.Decoding
Colonnade.Internal.Ap Colonnade.Internal.Ap
build-depends: build-depends:
base >= 4.7 && < 5 base >= 4.7 && < 5
, contravariant , contravariant
, vector , vector

View File

@ -9,7 +9,7 @@ import Data.Functor.Contravariant
-- constraint means that @f@ can be 'Headless' but not 'Headed'. -- 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 :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decoding f c1 a -> Decoding f c2 a
contramapContent f = go contramapContent f = go
where where
go :: forall b. Decoding f c1 b -> Decoding f c2 b go :: forall b. Decoding f c1 b -> Decoding f c2 b
go (DecodingPure x) = DecodingPure x go (DecodingPure x) = DecodingPure x
go (DecodingAp h decode apNext) = go (DecodingAp h decode apNext) =

View File

@ -4,7 +4,7 @@ import Colonnade.Types
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a 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 $ Vector.map (\(h,c) -> (fmap f h,f . c)) v
headless :: (a -> content) -> Encoding Headless content a headless :: (a -> content) -> Encoding Headless content a

View File

@ -28,10 +28,10 @@ instance Contravariant Headless where
-- Check out @Control.Applicative.Free@ in the @free@ library to -- Check out @Control.Applicative.Free@ in the @free@ library to
-- learn more about this. -- learn more about this.
data Decoding f content a where data Decoding f content a where
DecodingPure :: !a DecodingPure :: !a
-> Decoding f content a -> Decoding f content a
DecodingAp :: !(f content) DecodingAp :: !(f content)
-> !(content -> Either String a) -> !(content -> Either String a)
-> !(Decoding f content (a -> b)) -> !(Decoding f content (a -> b))
-> Decoding f content b -> Decoding f content b
@ -44,17 +44,17 @@ instance Applicative (Decoding f content) where
DecodingPure f <*> y = fmap f y DecodingPure f <*> y = fmap f y
DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z) 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) } { getEncoding :: Vector (f content,a -> content) }
deriving (Monoid) deriving (Monoid)
instance Contravariant (Encoding f content) where instance Contravariant (Encoding f content) where
contramap f (Encoding v) = Encoding contramap f (Encoding v) = Encoding
(Vector.map (\(h,c) -> (h, c . f)) v) (Vector.map (\(h,c) -> (h, c . f)) v)
instance Divisible (Encoding f content) where instance Divisible (Encoding f content) where
conquer = Encoding Vector.empty conquer = Encoding Vector.empty
divide f (Encoding a) (Encoding b) = divide f (Encoding a) (Encoding b) =
Encoding $ (Vector.++) Encoding $ (Vector.++)
(Vector.map (\(h,c) -> (h,c . fst . f)) a) (Vector.map (\(h,c) -> (h,c . fst . f)) a)
(Vector.map (\(h,c) -> (h,c . snd . f)) b) (Vector.map (\(h,c) -> (h,c . snd . f)) b)

View File

@ -16,12 +16,14 @@ library
hs-source-dirs: src hs-source-dirs: src
exposed-modules: exposed-modules:
Reflex.Dom.Colonnade Reflex.Dom.Colonnade
build-depends: build-depends:
base >= 4.7 && < 5 base >= 4.7 && < 5
, colonnade , colonnade
, contravariant , contravariant
, vector , vector
, reflex
, reflex-dom , reflex-dom
, containers
default-language: Haskell2010 default-language: Haskell2010
source-repository head source-repository head

View File

@ -1,15 +1,50 @@
module Reflex.Dom.Colonnade where module Reflex.Dom.Colonnade where
import Colonnade.Types import Colonnade.Types
import Control.Monad
import Reflex (Dynamic)
import Reflex.Dynamic (mapDyn)
import Reflex.Dom (MonadWidget)
import Reflex.Dom.Widget.Basic import Reflex.Dom.Widget.Basic
import Data.Map (Map)
import qualified Data.Map as Map
-- hmm... cell :: m () -> Cell m
-- data WithAttrs cell = Cell Map.empty
basic :: MonadWidget t m data Cell m = Cell
=> Encoding Headed (m ()) Int { 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 () -> m ()
basic (Encoding v) = do basic tableAttrs as (Encoding v) = do
el "table" $ do elAttr "table" tableAttrs $ do
el "thead" $ mapM_ (getHeaded . fst) v 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 ()