Heterogeneous List and Incremental?

Vinyl's Rec is similar to FHList. It turns out thats its possible to write some interesting functions related to reflex with it. Basically it is possible to easily convert between Rec (Dynamic t) xs and Incremental t (RecPatch xs) where xs is any list of types. I'm not entirely sure if this has any practical value. I'm also wondering if it is possible to make a RecDeepPatch and if this could be made more efficient by using DMap.

{-# LANGUAGE OverloadedStrings, RecursiveDo, LambdaCase, GADTs, DataKinds, TypeOperators, KindSignatures, TypeFamilies, RankNTypes, TypeApplications, ScopedTypeVariables, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, PartialTypeSignatures #-}
module Main where

import Reflex.Dom
import Data.Text
import Control.Monad
import Data.Vinyl
import Data.Vinyl.TypeLevel
import Data.These
import Data.Align
import Control.Lens hiding (rmap)
import Data.Constraint
import Data.Proxy

type family RecApplicatives (ts :: [*]) :: Constraint where
    RecApplicatives '[] = ()
    RecApplicatives (t:ts) = (RecApplicative ts, RecApplicatives ts)

mergeRecAlign :: RecApplicatives ts => Align f => Rec f ts -> f (Rec Maybe ts)
mergeRecAlign RNil = nil
mergeRecAlign (f :& fs) = align f (mergeRecAlign fs) <&> \case
    This a -> Just a :& rpure Nothing
    These a b -> Just a :& b
    That b -> Nothing :& b

class r ∈ rs => ElemOf rs r where
instance r ∈ rs => ElemOf rs r where

fromWitnesses :: forall rs b. (AllConstrained (ElemOf rs) rs, RecApplicative rs) => (forall r. (r ∈ rs) => b r) -> Rec b rs
fromWitnesses f = rpureConstrained (Proxy @(ElemOf rs)) f

fanRecFunctorMaybe :: (AllConstrained (ElemOf ts) ts, RecApplicative ts, FunctorMaybe f) => f (Rec Maybe ts) -> Rec f ts
fanRecFunctorMaybe x = fromWitnesses (fmapMaybe (rget Proxy) x)

data RecPatch ts = RecPatch { unRecPatch :: Rec Maybe ts }

recPatchHelper :: Rec Maybe ts -> Rec Identity ts -> Rec Identity ts
recPatchHelper RNil RNil = RNil
recPatchHelper (Nothing :& ps) (o :& os) = o :& recPatchHelper ps os
recPatchHelper (Just n :& ps) (o :& os) = Identity n :& recPatchHelper ps os

mergeRecApplicative :: Applicative a => Rec a ts -> a (Rec Identity ts)
mergeRecApplicative = rtraverse (fmap Identity)

fanRecFunctor :: (AllConstrained (ElemOf ts) ts, RecApplicative ts, Functor f) => f (Rec Identity ts) -> Rec f ts
fanRecFunctor x = fromWitnesses (fmap (runIdentity . rget Proxy) x)

instance Patch (RecPatch ts) where
    type PatchTarget (RecPatch ts) = Rec Identity ts
    apply (RecPatch patch) old = Just $ recPatchHelper patch old

fanRecIncremental :: (RecApplicative xs, Reflex t, AllConstrained (ElemOf xs) xs) => Incremental t (RecPatch xs) -> Rec (Dynamic t) xs
fanRecIncremental i = rzipWith unsafeDynamic (fanRecFunctor (currentIncremental i)) (fanRecFunctorMaybe (fmap unRecPatch (updatedIncremental i)))

mergeRecIncremental :: (RecApplicatives xs, Reflex t) => Rec (Dynamic t) xs -> Incremental t (RecPatch xs)
mergeRecIncremental d = unsafeBuildIncremental (sample (mergeRecApplicative (rmap current d))) (fmap RecPatch (mergeRecAlign (rmap updated d)))

main :: IO ()
main = mainWidget $ do
    rec
        let initial :: Rec Identity '[Integer, String] = Identity 1 :& Identity "hi" :& RNil
        let events = leftmost [reset, mergeRecAlign (leftmost [zero, one] :& leftmost [bye,hi] :& RNil)]
        zero <- (0 <$) <$> button "0"
        one <- (1 <$) <$> button "1"
        bye <- ("bye" <$) <$> button "bye"
        hi <- ("hi" <$) <$> button "hi"
        reset <- (rmap (Just . runIdentity) initial <$) <$> button "Reset Both"
        i <- holdIncremental initial (RecPatch <$> events)
        el "div" $ display (incrementalToDynamic i)
        let ds = fanRecIncremental i
        el "div" $ display (rget (Proxy @Integer) ds)
        el "div" $ display (rget (Proxy @String) ds)
    return ()

Yeah, I definitely am interested in this enhancement.

Somewhat relatedly, was playing around with some helpers here:

https://github.com/sboosali/reflex-vinyl/blob/master/sources/Reflex/Vinyl/Types.hs

To make widgets that listen to ad-hoc subsets of reflex-dom events:

https://github.com/sboosali/reflex-vinyl/blob/master/sources/Reflex/Vinyl/Example.hs


myWidget :: SomeWidget_
myWidget = do
 let child = blank

 (es, x) <- elFor'
             (Click :& Mousemove :& RNil)
             "div"
             (constDyn mempty)
             child

 let _eClick     = es ^. event Click
 let _eMousemove = es ^. event Mousemove

 ...

On Fri, Mar 30, 2018, 6:51 PM 2426021684 notifications@github.com wrote:

Vinyl's Rec is similar to FHList. It turns out thats its possible to write some interesting functions related to reflex with it. Basically it is possible to easily convert between Rec (Dynamic t) xs and Incremental t (RecPatch xs) where xs is any list of types. I'm not entirely sure if this has any practical value. I'm also wondering if it is possible to make a RecDeepPatch and if this could be made more efficient by using DMap.

{-# LANGUAGE OverloadedStrings, RecursiveDo, LambdaCase, GADTs, DataKinds, TypeOperators, KindSignatures, TypeFamilies, RankNTypes, TypeApplications, ScopedTypeVariables, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances, PartialTypeSignatures #-}module Main where import Reflex.Domimport Data.Textimport Control.Monadimport Data.Vinylimport Data.Vinyl.TypeLevelimport Data.Theseimport Data.Alignimport Control.Lens hiding (rmap)import Data.Constraintimport Data.Proxy type family RecApplicatives (ts :: [*]) :: Constraint where RecApplicatives '[] = () RecApplicatives (t:ts) = (RecApplicative ts, RecApplicatives ts) mergeRecAlign :: RecApplicatives ts => Align f => Rec f ts -> f (Rec Maybe ts) mergeRecAlign RNil = nil mergeRecAlign (f :& fs) = align f (mergeRecAlign fs) <&> \case This a -> Just a :& rpure Nothing These a b -> Just a :& b That b -> Nothing :& b class r ∈ rs => ElemOf rs r whereinstance r ∈ rs => ElemOf rs r where fromWitnesses :: forall rs b. (AllConstrained (ElemOf rs) rs, RecApplicative rs) => (forall r. (r ∈ rs) => b r) -> Rec b rs fromWitnesses f = rpureConstrained (Proxy @(ElemOf rs)) f fanRecFunctorMaybe :: (AllConstrained (ElemOf ts) ts, RecApplicative ts, FunctorMaybe f) => f (Rec Maybe ts) -> Rec f ts fanRecFunctorMaybe x = fromWitnesses (fmapMaybe (rget Proxy) x) data RecPatch ts = RecPatch { unRecPatch :: Rec Maybe ts } recPatchHelper :: Rec Maybe ts -> Rec Identity ts -> Rec Identity ts recPatchHelper RNil RNil = RNil recPatchHelper (Nothing :& ps) (o :& os) = o :& recPatchHelper ps os recPatchHelper (Just n :& ps) (o :& os) = Identity n :& recPatchHelper ps os mergeRecApplicative :: Applicative a => Rec a ts -> a (Rec Identity ts) mergeRecApplicative = rtraverse (fmap Identity) fanRecFunctor :: (AllConstrained (ElemOf ts) ts, RecApplicative ts, Functor f) => f (Rec Identity ts) -> Rec f ts fanRecFunctor x = fromWitnesses (fmap (runIdentity . rget Proxy) x) instance Patch (RecPatch ts) where type PatchTarget (RecPatch ts) = Rec Identity ts apply (RecPatch patch) old = Just $ recPatchHelper patch old fanRecIncremental :: (RecApplicative xs, Reflex t, AllConstrained (ElemOf xs) xs) => Incremental t (RecPatch xs) -> Rec (Dynamic t) xs fanRecIncremental i = rzipWith unsafeDynamic (fanRecFunctor (currentIncremental i)) (fanRecFunctorMaybe (fmap unRecPatch (updatedIncremental i))) mergeRecIncremental :: (RecApplicatives xs, Reflex t) => Rec (Dynamic t) xs -> Incremental t (RecPatch xs) mergeRecIncremental d = unsafeBuildIncremental (sample (mergeRecApplicative (rmap current d))) (fmap RecPatch (mergeRecAlign (rmap updated d))) main :: IO () main = mainWidget $ do rec let initial :: Rec Identity '[Integer, String] = Identity 1 :& Identity "hi" :& RNil let events = leftmost [reset, mergeRecAlign (leftmost [zero, one] :& leftmost [bye,hi] :& RNil)] zero <- (0 <$) <$> button "0" one <- (1 <$) <$> button "1" bye <- ("bye" <$) <$> button "bye" hi <- ("hi" <$) <$> button "hi" reset <- (rmap (Just . runIdentity) initial <$) <$> button "Reset Both" i <- holdIncremental initial (RecPatch <$> events) el "div" $ display (incrementalToDynamic i) let ds = fanRecIncremental i el "div" $ display (rget (Proxy @Integer) ds) el "div" $ display (rget (Proxy @String) ds) return ()

— You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub https://github.com/reflex-frp/reflex/issues/182, or mute the thread https://github.com/notifications/unsubscribe-auth/ACNoMXqEsqZa5XfadOV2EQS2xf7jR2bZks5tjs2VgaJpZM4TCQyC .

reflex-frp / reflex

Heterogeneous List and Incremental? #182