56fcac1 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Additional cleanups

56fcac1Ryan Trinkle8 years ago

src/Reflex/Class.hs+41−26

compare with develop

unifiedsplit

@@ -48,6 +48,9 @@ module Reflex.Class

48 , mergeMapIncremental

49 , mergeMapIncrementalWithMove

50 , mergeIntMapIncremental

51+ , coincidencePatchMap

52+ , coincidencePatchMapWithMove

53+ , coincidencePatchIntMap

51 , mergeList

54 , mergeList

52 , mergeWith

55 , mergeWith

53 , difference

56 , difference

@@ -193,6 +196,7 @@ import Data.These

193import Data.Type.Coercion

196import Data.Type.Coercion

194import Reflex.FunctorMaybe

197import Reflex.FunctorMaybe

195import Reflex.Patch

198import Reflex.Patch

199+import qualified Reflex.Patch.MapWithMove as PatchMapWithMove

196

200

197import Debug.Trace (trace)

201import Debug.Trace (trace)

198

202

@@ -865,42 +869,53 @@ switchHoldPromptOnly e0 e' = do

865 eLag <- switch <$> hold e0 e'

869 eLag <- switch <$> hold e0 e'

866 return $ coincidence $ leftmost [e', eLag <$ eLag]

870 return $ coincidence $ leftmost [e', eLag <$ eLag]

867

871

868−data ApplyElement p

872+-- | When the given outer event fires, condense the inner events into the contained patch. Non-firing inner events will be replaced with deletions.

869− = Append (PatchTarget p)

873+coincidencePatchMap :: (Reflex t, Ord k) => Event t (PatchMap k (Event t v)) -> Event t (PatchMap k v)

870− | Apply p

874+coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m) -> mergeMap $ ffor m $ \case

875+ Nothing -> fmapCheap (const Nothing) e

876+ Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]

877+

878+-- | See 'coincicencePatchMap'

879+coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)

880+coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case

881+ Nothing -> fmapCheap (const Nothing) e

882+ Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]

883+

884+-- | See 'coincicencePatchMap'

885+coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)

886+coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of

887+ PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->

888+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }

889+ PatchMapWithMove.From_Move k -> fforCheap e $ \_ ->

890+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Move k }

891+ PatchMapWithMove.From_Insert ev -> leftmost

892+ [ fforCheap ev $ \v ->

893+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Insert v }

894+ , fforCheap e $ \_ ->

895+ ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }

896+ ]

871

897

872−-- | Like 'switchHoldPromptOnly' but for a patchable data structure of events.

873switchHoldPromptOnlyIncremental

898switchHoldPromptOnlyIncremental

874 :: forall t m p pt w

899 :: forall t m p pt w

875 . ( Reflex t

900 . ( Reflex t

876 , MonadHold t m

901 , MonadHold t m

877− , Functor p

878− , Functor pt

879− , FunctorMaybe pt

880− , Monoid (pt (Maybe w))

881− , Patch (p (Maybe w))

882− , PatchTarget (p (Maybe w)) ~ pt (Maybe w)

883 , Patch (p (Event t w))

902 , Patch (p (Event t w))

884 , PatchTarget (p (Event t w)) ~ pt (Event t w)

903 , PatchTarget (p (Event t w)) ~ pt (Event t w)

904+ , Patch (p w)

905+ , PatchTarget (p w) ~ pt w

906+ , Monoid (pt w)

885 )

907 )

908+ => (Incremental t (p (Event t w)) -> Event t (pt w))

909+ -> (Event t (p (Event t w)) -> Event t (p w))

886− => pt (Event t w)

910+ -> pt (Event t w)

887 -> Event t (p (Event t w))

911 -> Event t (p (Event t w))

888− -> (p (Event t w) -> Event t (pt w))

889− -> (Incremental t (p (Event t w)) -> Event t (pt w))

890 -> m (Event t (pt w))

912 -> m (Event t (pt w))

891−switchHoldPromptOnlyIncremental e0 ee mergePatchNewElements mergePatchIncremental = do

913+switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = do

892− let replaced :: Event t (ApplyElement (p (Maybe w)))

893− replaced = fmapCheap (Apply . (Nothing <$)) ee

894− new :: Event t (ApplyElement (p (Maybe w)))

895− new = fmapCheap (Append . fmap Just) $ coincidence $ fmapCheap mergePatchNewElements ee

896− held <- fmapCheap (Append . fmap Just) . mergePatchIncremental <$> holdIncremental e0 ee

914+ lag <- mergePatchIncremental <$> holdIncremental e0 e'

897− let e = mergeList [held, replaced, new]

915+ pure $ ffor (align lag (coincidencePatch e')) $ \case

898− return $ fmap (fmapMaybe id . foldl' applyElement mempty) e

916+ This old -> old

899− where

917+ That new -> new `applyAlways` mempty

900− applyElement :: pt (Maybe w) -> ApplyElement (p (Maybe w)) -> pt (Maybe w)

918+ These old new -> new `applyAlways` old

901− applyElement pt = \case

902− Append new -> new <> pt

903− Apply p -> applyAlways p pt

904

919

905instance Reflex t => Align (Event t) where

920instance Reflex t => Align (Event t) where

906 nil = never

921 nil = never

src/Reflex/EventWriter/Base.hs+53−34

@@ -4,7 +4,6 @@

4{-# LANGUAGE ExistentialQuantification #-}

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

7−{-# LANGUAGE LambdaCase #-}

8{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE Rank2Types #-}

8{-# LANGUAGE Rank2Types #-}

10{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE ScopedTypeVariables #-}

@@ -136,9 +135,9 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where

136

135

137instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

136instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

138 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

137 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

139− traverseIntMapWithKeyWithAdjust = sequenceIntMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') (mergeIntMap . patchIntMapNewElementsMap) mergeIntIncremental

138+ traverseIntMapWithKeyWithAdjust = sequenceIntMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseIntMapWithKeyWithAdjust f dm0 dm') mergeIntIncremental coincidencePatchIntMap

140− traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith (mergeMap . patchMapNewElementsMap) mergeMapIncremental

139+ traverseDMapWithKeyWithAdjust = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjust f dm0 dm') mapPatchDMap weakenPatchDMapWith mergeMapIncremental coincidencePatchMap

141− traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith (mergeMap . patchMapWithMoveNewElementsMap) mergeMapIncrementalWithMove

140+ traverseDMapWithKeyWithAdjustWithMove = sequenceDMapWithAdjustEventWriterTWith (\f dm0 dm' -> lift $ traverseDMapWithKeyWithAdjustWithMove f dm0 dm') mapPatchDMapWithMove weakenPatchDMapWithMoveWith mergeMapIncrementalWithMove coincidencePatchMapWithMove

142

141

143instance Requester t m => Requester t (EventWriterT t w m) where

142instance Requester t m => Requester t (EventWriterT t w m) where

144 type Request (EventWriterT t w m) = Request m

143 type Request (EventWriterT t w m) = Request m

@@ -161,19 +160,29 @@ runWithReplaceEventWriterTWith f a0 a' = do

161 return (fst result0, fmapCheap fst result')

160 return (fst result0, fmapCheap fst result')

162

161

163-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceIntMapWithAdjust'.

162-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceIntMapWithAdjust'.

164−sequenceIntMapWithAdjustEventWriterTWith :: forall t m p w v v'. (Reflex t, MonadHold t m, Semigroup w, Functor p, Patch (p (Event t w)), PatchTarget (p (Event t w)) ~ IntMap (Event t w), Patch (p (Maybe w)), PatchTarget (p (Maybe w)) ~ IntMap (Maybe w))

163+sequenceIntMapWithAdjustEventWriterTWith

164+ :: forall t m p w v v'

165+ . ( Reflex t

166+ , MonadHold t m

167+ , Semigroup w

168+ , Functor p

169+ , Patch (p (Event t w))

170+ , PatchTarget (p (Event t w)) ~ IntMap (Event t w)

171+ , Patch (p w)

172+ , PatchTarget (p w) ~ IntMap w

173+ )

165− => ( (IntMap.Key -> v -> m (Event t w, v'))

174+ => ( (IntMap.Key -> v -> m (Event t w, v'))

166− -> IntMap v

175+ -> IntMap v

167− -> Event t (p v)

176+ -> Event t (p v)

168− -> EventWriterT t w m (IntMap (Event t w, v'), Event t (p (Event t w, v')))

177+ -> EventWriterT t w m (IntMap (Event t w, v'), Event t (p (Event t w, v')))

169− )

178+ )

170− -> (p (Event t w) -> Event t (IntMap w))

171− -> (Incremental t (p (Event t w)) -> Event t (IntMap w))

179+ -> (Incremental t (p (Event t w)) -> Event t (PatchTarget (p w)))

180+ -> (Event t (p (Event t w)) -> Event t (p w))

172− -> (IntMap.Key -> v -> EventWriterT t w m v')

181+ -> (IntMap.Key -> v -> EventWriterT t w m v')

173− -> IntMap v

182+ -> IntMap v

174− -> Event t (p v)

183+ -> Event t (p v)

175− -> EventWriterT t w m (IntMap v', Event t (p v'))

184+ -> EventWriterT t w m (IntMap v', Event t (p v'))

176−sequenceIntMapWithAdjustEventWriterTWith base mergePatchNewElements mergePatchIncremental f dm0 dm' = do

185+sequenceIntMapWithAdjustEventWriterTWith base mergePatchIncremental coincidencePatch f dm0 dm' = do

177 let f' :: IntMap.Key -> v -> m (Event t w, v')

186 let f' :: IntMap.Key -> v -> m (Event t w, v')

178 f' k v = swap <$> runEventWriterT (f k v)

187 f' k v = swap <$> runEventWriterT (f k v)

179 (children0, children') <- base f' dm0 dm'

188 (children0, children') <- base f' dm0 dm'

@@ -183,7 +192,7 @@ sequenceIntMapWithAdjustEventWriterTWith base mergePatchNewElements mergePatchIn

183 requests0 = fmap fst children0

192 requests0 = fmap fst children0

184 requests' :: Event t (p (Event t w))

193 requests' :: Event t (p (Event t w))

185 requests' = fmapCheap (fmap fst) children'

194 requests' = fmapCheap (fmap fst) children'

186− e <- switchHoldPromptOnlyIncremental requests0 requests' mergePatchNewElements mergePatchIncremental

195+ e <- switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch requests0 requests'

187 tellEvent $ fforMaybeCheap e $ \m ->

196 tellEvent $ fforMaybeCheap e $ \m ->

188 case IntMap.elems m of

197 case IntMap.elems m of

189 [] -> Nothing

198 [] -> Nothing

@@ -191,21 +200,31 @@ sequenceIntMapWithAdjustEventWriterTWith base mergePatchNewElements mergePatchIn

191 return (result0, result')

200 return (result0, result')

192

201

193-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.

202-- | Like 'runWithReplaceEventWriterTWith', but for 'sequenceDMapWithAdjust'.

194−sequenceDMapWithAdjustEventWriterTWith :: forall t m p p' w k v v'. (Reflex t, MonadHold t m, Semigroup w, Patch (p' (Some k) (Event t w)), PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w), GCompare k, PatchTarget (p' (Some k) w) ~ Map (Some k) w, Patch (p' (Some k) (Maybe w)), PatchTarget (p' (Some k) (Maybe w)) ~ Map (Some k) (Maybe w), Functor (p' (Some k)))

203+sequenceDMapWithAdjustEventWriterTWith

204+ :: forall t m p p' w k v v'

205+ . ( Reflex t

206+ , MonadHold t m

207+ , Semigroup w

208+ , Patch (p' (Some k) (Event t w))

209+ , PatchTarget (p' (Some k) (Event t w)) ~ Map (Some k) (Event t w)

210+ , GCompare k

211+ , Patch (p' (Some k) w)

212+ , PatchTarget (p' (Some k) w) ~ Map (Some k) w

213+ )

195− => ( (forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a))

214+ => ( (forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a))

196− -> DMap k v

215+ -> DMap k v

197− -> Event t (p k v)

216+ -> Event t (p k v)

198− -> EventWriterT t w m (DMap k (Compose ((,) (Event t w)) v'), Event t (p k (Compose ((,) (Event t w)) v')))

217+ -> EventWriterT t w m (DMap k (Compose ((,) (Event t w)) v'), Event t (p k (Compose ((,) (Event t w)) v')))

199− )

218+ )

200− -> ((forall a. Compose ((,) (Event t w)) v' a -> v' a) -> p k (Compose ((,) (Event t w)) v') -> p k v')

219+ -> ((forall a. Compose ((,) (Event t w)) v' a -> v' a) -> p k (Compose ((,) (Event t w)) v') -> p k v')

201− -> ((forall a. Compose ((,) (Event t w)) v' a -> Event t w) -> p k (Compose ((,) (Event t w)) v') -> p' (Some k) (Event t w))

220+ -> ((forall a. Compose ((,) (Event t w)) v' a -> Event t w) -> p k (Compose ((,) (Event t w)) v') -> p' (Some k) (Event t w))

202− -> (p' (Some k) (Event t w) -> Event t (PatchTarget (p' (Some k) w)))

203− -> (Incremental t (p' (Some k) (Event t w)) -> Event t (Map (Some k) w))

221+ -> (Incremental t (p' (Some k) (Event t w)) -> Event t (PatchTarget (p' (Some k) w)))

222+ -> (Event t (p' (Some k) (Event t w)) -> Event t (p' (Some k) w))

204− -> (forall a. k a -> v a -> EventWriterT t w m (v' a))

223+ -> (forall a. k a -> v a -> EventWriterT t w m (v' a))

205− -> DMap k v

224+ -> DMap k v

206− -> Event t (p k v)

225+ -> Event t (p k v)

207− -> EventWriterT t w m (DMap k v', Event t (p k v'))

226+ -> EventWriterT t w m (DMap k v', Event t (p k v'))

208−sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith mergePatchNewElements mergePatchIncremental f dm0 dm' = do

227+sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith mergePatchIncremental coincidencePatch f dm0 dm' = do

209 let f' :: forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a)

228 let f' :: forall a. k a -> v a -> m (Compose ((,) (Event t w)) v' a)

210 f' k v = Compose . swap <$> runEventWriterT (f k v)

229 f' k v = Compose . swap <$> runEventWriterT (f k v)

211 (children0, children') <- base f' dm0 dm'

230 (children0, children') <- base f' dm0 dm'

@@ -215,7 +234,7 @@ sequenceDMapWithAdjustEventWriterTWith base mapPatch weakenPatchWith mergePatchN

215 requests0 = weakenDMapWith (fst . getCompose) children0

234 requests0 = weakenDMapWith (fst . getCompose) children0

216 requests' :: Event t (p' (Some k) (Event t w))

235 requests' :: Event t (p' (Some k) (Event t w))

217 requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose

236 requests' = fforCheap children' $ weakenPatchWith $ fst . getCompose

218− e <- switchHoldPromptOnlyIncremental requests0 requests' mergePatchNewElements mergePatchIncremental

237+ e <- switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch requests0 requests'

219 tellEvent $ fforMaybeCheap e $ \m ->

238 tellEvent $ fforMaybeCheap e $ \m ->

220 case Map.elems m of

239 case Map.elems m of

221 [] -> Nothing

240 [] -> Nothing