63442b9 · patch · git.iko.soy

src/Reflex/Class.hs+23−11

compare with develop

unifiedsplit

@@ -61,6 +61,7 @@ module Reflex.Class

61 , eitherToDSum

62 , dsumToEither

63 , factorEvent

64+ , filterEventKey

64 -- ** Collapsing 'Event . Event'

65 -- ** Collapsing 'Event . Event'

65 , switchHold

66 , switchHold

66 , switchHoldPromptly

67 , switchHoldPromptly

@@ -337,7 +338,7 @@ class MonadSample t m => MonadHold t m where

337 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)

338 holdIncremental :: Patch p => PatchTarget p -> Event t p -> m (Incremental t p)

338 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)

339 default holdIncremental :: (Patch p, m ~ f m', MonadTrans f, MonadHold t m') => PatchTarget p -> Event t p -> m (Incremental t p)

339 holdIncremental v0 = lift . holdIncremental v0

340 holdIncremental v0 = lift . holdIncremental v0

340− buildDynamic :: PullM t a -> Event t a -> m (Dynamic t a)

341+ buildDynamic :: PushM t a -> Event t a -> m (Dynamic t a)

341 {-

342 {-

342 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)

343 default buildDynamic :: (m ~ f m', MonadTrans f, MonadHold t m') => PullM t a -> Event t a -> m (Dynamic t a)

343 buildDynamic getV0 = lift . buildDynamic getV0

344 buildDynamic getV0 = lift . buildDynamic getV0

@@ -904,6 +905,24 @@ alignEventWithMaybe f ea eb =

904 $ merge

905 $ merge

905 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]

906 $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]

906

907

908+filterEventKey

909+ :: forall t m k v a.

910+ ( Reflex t

911+ , MonadFix m

912+ , MonadHold t m

913+ , GEq k

914+ )

915+ => k a

916+ -> Event t (DSum k v)

917+ -> m (Event t (v a))

918+filterEventKey k kv' = do

919+ let f :: DSum k v -> Maybe (v a)

920+ f (newK :=> newV) = case newK `geq` k of

921+ Just Refl -> Just newV

922+ Nothing -> Nothing

923+ takeWhileJustE f kv'

924+

925+

907factorEvent

926factorEvent

908 :: forall t m k v a.

927 :: forall t m k v a.

909 ( Reflex t

928 ( Reflex t

@@ -916,20 +935,13 @@ factorEvent

916 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))

935 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))

917factorEvent k0 kv' = do

936factorEvent k0 kv' = do

918 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'

937 key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'

919− let inner :: forall m' b. (MonadFix m', MonadHold t m') => k b -> m' (Event t (v b))

920− inner k = do

921− let f :: DSum k v -> Maybe (v b)

922− f (newK :=> newV) = case newK `geq` k of

923− Just Refl -> Just newV

924− Nothing -> Nothing

925− takeWhileJustE f kv'

926− update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case

938+ let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case

927 Some.This oldKey -> case newKey `geq` oldKey of

939 Some.This oldKey -> case newKey `geq` oldKey of

928 Just Refl -> return Nothing

940 Just Refl -> return Nothing

929 Nothing -> do

941 Nothing -> do

930− newInner <- inner newKey

942+ newInner <- filterEventKey newKey kv'

931 return $ Just $ newKey :=> Pair newVal (Compose newInner)

943 return $ Just $ newKey :=> Pair newVal (Compose newInner)

932− eInitial <- inner k0

944+ eInitial <- filterEventKey k0 kv'

933 return (eInitial, update)

945 return (eInitial, update)

934

946

935--------------------------------------------------------------------------------

947--------------------------------------------------------------------------------

src/Reflex/Dynamic.hs+14−10

@@ -325,16 +325,20 @@ eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum

325 LeftTag :=> Compose a -> Left $ coerceDynamic a

326 RightTag :=> Compose b -> Right $ coerceDynamic b

327

328+factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)

328−factorDyn :: forall t m k v. (Reflex t, MonadFix m, MonadHold t m, GEq k) => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))

329+ => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))

329−factorDyn d = do

330+factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where

330− k0 :=> v0 <- sample $ current d --TODO: Figure out how to get this to run inside something like the first argument to buildDynamic

331+ update :: Event t (DSum k (Compose (Dynamic t) v))

331− (initialEvent, update) <- factorEvent k0 $ updated d

332+ update = flip push (updated d) $ \(newKey :=> newVal) -> do

332− initialD <- holdDyn v0 initialEvent

333+ (oldKey :=> _) <- sample (current d)

333− let f (k :=> Pair v (Compose v')) = do

334+ case newKey `geq` oldKey of

334− d' <- holdDyn v v'

335+ Just Refl -> return Nothing

335− pure $ k :=> Compose d'

336+ Nothing -> Just <$> holdKey (newKey :=> newVal)

336− holdDyn (k0 :=> Compose initialD) $ pushAlwaysCheap f update

337+

337−

338+ holdKey (k :=> v) = do

339+ inner' <- filterEventKey k (updated d)

340+ inner <- holdDyn v inner'

341+ return $ k :=> Compose inner

338--------------------------------------------------------------------------------

342--------------------------------------------------------------------------------

339-- Demux

343-- Demux

340--------------------------------------------------------------------------------

344--------------------------------------------------------------------------------

src/Reflex/DynamicWriter/Base.hs+7−1

@@ -9,6 +9,7 @@

9{-# LANGUAGE TupleSections #-}

10{-# LANGUAGE TypeFamilies #-}

11{-# LANGUAGE UndecidableInstances #-}

12+{-# LANGUAGE StandaloneDeriving #-}

12#ifdef USE_REFLEX_OPTIMIZER

13#ifdef USE_REFLEX_OPTIMIZER

13{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

14{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

14#endif

15#endif

@@ -85,7 +86,12 @@ mergeDynIncrementalWithMove a = unsafeBuildIncremental (mapM (sample . current)

85 in Map.differenceWith (\e _ -> Just $ MapWithMove.nodeInfoSetTo Nothing e) pWithNewVals noLongerMovedMap --TODO: Check if any in the second map are not covered?

86 in Map.differenceWith (\e _ -> Just $ MapWithMove.nodeInfoSetTo Nothing e) pWithNewVals noLongerMovedMap --TODO: Check if any in the second map are not covered?

86

87

87-- | A basic implementation of 'MonadDynamicWriter'.

88-- | A basic implementation of 'MonadDynamicWriter'.

89+newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a }

88−newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadHold t, MonadSample t, MonadAsyncException, MonadException) -- The list is kept in reverse order

90+ deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadAsyncException, MonadException) -- The list is kept in reverse order

91+

92+deriving instance MonadHold t m => MonadHold t (DynamicWriterT t w m)

93+deriving instance MonadSample t m => MonadSample t (DynamicWriterT t w m)

94+

89

95

90instance MonadRef m => MonadRef (DynamicWriterT t w m) where

96instance MonadRef m => MonadRef (DynamicWriterT t w m) where

91 type Ref (DynamicWriterT t w m) = Ref m

97 type Ref (DynamicWriterT t w m) = Ref m

src/Reflex/Query/Base.hs+6−1

@@ -8,6 +8,8 @@

8{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE UndecidableInstances #-}

11+{-# LANGUAGE StandaloneDeriving #-}

12+

11module Reflex.Query.Base

13module Reflex.Query.Base

12 ( QueryT (..)

14 ( QueryT (..)

13 , runQueryT

15 , runQueryT

@@ -50,7 +52,10 @@ import Reflex.Requester.Class

50import Reflex.TriggerEvent.Class

52import Reflex.TriggerEvent.Class

51

53

52newtype QueryT t q m a = QueryT { unQueryT :: StateT [Behavior t q] (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m)) a }

54newtype QueryT t q m a = QueryT { unQueryT :: StateT [Behavior t q] (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m)) a }

53− deriving (Functor, Applicative, Monad, MonadException, MonadFix, MonadIO, MonadHold t, MonadSample t, MonadAtomicRef)

55+ deriving (Functor, Applicative, Monad, MonadException, MonadFix, MonadIO, MonadAtomicRef)

56+

57+deriving instance MonadHold t m => MonadHold t (QueryT t q m)

58+deriving instance MonadSample t m => MonadSample t (QueryT t q m)

54

59

55runQueryT :: (MonadFix m, Additive q, Group q, Reflex t) => QueryT t q m a -> Dynamic t (QueryResult q) -> m (a, Incremental t (AdditivePatch q))

60runQueryT :: (MonadFix m, Additive q, Group q, Reflex t) => QueryT t q m a -> Dynamic t (QueryResult q) -> m (a, Incremental t (AdditivePatch q))

56runQueryT (QueryT a) qr = do

61runQueryT (QueryT a) qr = do

src/Reflex/Spider/Internal.hs+19−8

@@ -1135,7 +1135,11 @@ instance HasSpiderTimeline x => Align (Event x) where

1135 nil = eventNever

1136 align ea eb = fmapMaybe dmapToThese $ merge $ dynamicConst $ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

1137

1138+data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)

1139+ | BuildDyn !(EventM x (PatchTarget p), Event x p)

1140+ | HoldDyn !(Hold x p)

1141+

1138−newtype Dyn x p = Dyn { unDyn :: IORef (Either (BehaviorM x (PatchTarget p), Event x p) (Hold x p)) }

1142+newtype Dyn x p = Dyn { unDyn :: IORef (DynType x p) }

1139

1143

1140newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1144newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1141newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

1145newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

@@ -1156,15 +1160,15 @@ zipDynWith f da db =

1156 return $ Just $ Identity $ f a b

1160 return $ Just $ Identity $ f a b

1157 in dynamicDynIdentity $ unsafeBuildDynamic (f <$> readBehaviorUntracked (dynamicCurrent da) <*> readBehaviorUntracked (dynamicCurrent db)) ec

1161 in dynamicDynIdentity $ unsafeBuildDynamic (f <$> readBehaviorUntracked (dynamicCurrent da) <*> readBehaviorUntracked (dynamicCurrent db)) ec

1158

1162

1159−buildDynamic :: (Defer (SomeDynInit x) m, Patch p) => BehaviorM x (PatchTarget p) -> Event x p -> m (Dyn x p)

1163+buildDynamic :: (Defer (SomeDynInit x) m, Patch p) => EventM x (PatchTarget p) -> Event x p -> m (Dyn x p)

1160buildDynamic readV0 v' = do

1164buildDynamic readV0 v' = do

1161− result <- liftIO $ newIORef $ Left (readV0, v')

1165+ result <- liftIO $ newIORef $ BuildDyn (readV0, v')

1162 let !d = Dyn result

1166 let !d = Dyn result

1163 defer $ SomeDynInit d

1167 defer $ SomeDynInit d

1164 return d

1168 return d

1165

1169

1166unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

1170unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

1167−unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ Left x

1171+unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x

1168 where x = (readV0, v')

1172 where x = (readV0, v')

1169

1173

1170-- ResultM can read behaviors and events

1174-- ResultM can read behaviors and events

@@ -1374,14 +1378,21 @@ getDynHold :: (Defer (SomeHoldInit x) m, Patch p) => Dyn x p -> m (Hold x p)

1374getDynHold d = do

1378getDynHold d = do

1375 mh <- liftIO $ readIORef $ unDyn d

1379 mh <- liftIO $ readIORef $ unDyn d

1376 case mh of

1380 case mh of

1377− Right h -> return h

1381+ HoldDyn h -> return h

1378− Left (readV0, v') -> do

1382+ UnsafeDyn (readV0, v') -> do

1379 holdInits <- getDeferralQueue

1383 holdInits <- getDeferralQueue

1380 v0 <- liftIO $ runBehaviorM readV0 Nothing holdInits

1384 v0 <- liftIO $ runBehaviorM readV0 Nothing holdInits

1385+ hold' v0 v'

1386+ BuildDyn (readV0, v') -> do

1387+ v0 <- liftIO $ runEventM readV0

1388+ hold' v0 v'

1389+ where

1390+ hold' v0 v' = do

1381 h <- hold v0 v'

1391 h <- hold v0 v'

1382− liftIO $ writeIORef (unDyn d) $ Right h

1392+ liftIO $ writeIORef (unDyn d) $ HoldDyn h

1383 return h

1393 return h

1384

1394

1395+

1385-- Always refers to 0

1396-- Always refers to 0

1386{-# NOINLINE zeroRef #-}

1397{-# NOINLINE zeroRef #-}

1387zeroRef :: IORef Height

1398zeroRef :: IORef Height

@@ -2317,7 +2328,7 @@ holdDynSpiderEventM v0 e = fmap (SpiderDynamic . dynamicHoldIdentity) $ Reflex.S

2317holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)

2328holdIncrementalSpiderEventM :: (HasSpiderTimeline x, Patch p) => PatchTarget p -> Reflex.Class.Event (SpiderTimeline x) p -> EventM x (Reflex.Class.Incremental (SpiderTimeline x) p)

2318holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

2329holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . dynamicHold) $ Reflex.Spider.Internal.hold v0 $ unSpiderEvent e

2319

2330

2320−buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPullM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

2331+buildDynamicSpiderEventM :: HasSpiderTimeline x => SpiderPushM x a -> Reflex.Class.Event (SpiderTimeline x) a -> EventM x (Reflex.Class.Dynamic (SpiderTimeline x) a)

2321buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

2332buildDynamicSpiderEventM getV0 e = fmap (SpiderDynamic . dynamicDynIdentity) $ Reflex.Spider.Internal.buildDynamic (coerce getV0) $ coerce $ unSpiderEvent e

2322

2333

2323instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where

2334instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (SpiderHost x) where

test/Reflex/Test/CrossImpl.hs+3

@@ -230,6 +230,9 @@ testCases =

230 rec result <- holdUniqDyn d

231 d <- holdDyn (0 :: Int) e

232 return (current result, updated result)

233+

234+

235+

233 {-

236 {-

234 , (,) "mergeIncrementalWithMove" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, PatchDMapWithMove.moveDMapKey LeftTag RightTag), (2, mempty)]) $ \(b, e :: Event t (PatchDMapWithMove (EitherTag () ()) (Const2 () ()))) -> do

237 , (,) "mergeIncrementalWithMove" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, PatchDMapWithMove.moveDMapKey LeftTag RightTag), (2, mempty)]) $ \(b, e :: Event t (PatchDMapWithMove (EitherTag () ()) (Const2 () ()))) -> do

235 x <- holdIncremental (DMap.singleton LeftTag $ void e) $ PatchDMapWithMove.mapPatchDMapWithMove (\(Const2 _) -> void e) <$> e

238 x <- holdIncremental (DMap.singleton LeftTag $ void e) $ PatchDMapWithMove.mapPatchDMapWithMove (\(Const2 _) -> void e) <$> e

test/Reflex/Test/Micro.hs+64−3

@@ -3,6 +3,7 @@

3{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GADTs #-}

6+{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE RankNTypes #-}

8{-# LANGUAGE RankNTypes #-}

8{-# LANGUAGE RecursiveDo #-}

9{-# LANGUAGE RecursiveDo #-}

@@ -23,6 +24,24 @@ import Data.Monoid

23

24

24import Prelude

25import Prelude

25

26

27+pushDyn :: (Reflex t, MonadHold t m) => (a -> PushM t b) -> Dynamic t a -> m (Dynamic t b)

28+pushDyn f d = buildDynamic (sample (current d) >>= f) (pushAlways f (updated d))

29+

30+foldedDyn :: (Reflex t, MonadHold t m) => (a -> a -> a) -> Dynamic t a -> m (Dynamic t a)

31+foldedDyn f d = fmap join $ flip buildDynamic never $ do

32+ a <- sample (current d)

33+ foldDyn f a (updated d)

34+

35+scannedDyn :: (Reflex t, MonadHold t m) => Dynamic t a -> m (Dynamic t [a])

36+scannedDyn = fmap (fmap reverse) . foldedDyn (<>) . fmap pure

37+

38+scanInnerDyns :: (Reflex t, MonadHold t m) => Dynamic t (Dynamic t a) -> m (Dynamic t [a])

39+scanInnerDyns d = do

40+ scans <- scannedDyn d

41+ return (join (fmap distributeListOverDynPure scans))

42+

43+

44+

26{-# ANN testCases "HLint: ignore Functor law" #-}

45{-# ANN testCases "HLint: ignore Functor law" #-}

27testCases :: [(String, TestCase)]

46testCases :: [(String, TestCase)]

28testCases =

47testCases =

@@ -201,6 +220,14 @@ testCases =

201 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo

220 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo

202 return $ pull $ sample =<< sample bb

221 return $ pull $ sample =<< sample bb

203

222

223+

224+ , testB "foldDynWhileFiring" $ do

225+ e <- events1

226+ d <- foldDyn (:) [] $

227+ pushAlways (\a -> foldDyn (:) [a] e) e

228+

229+ return $ current (join (fmap distributeListOverDynPure d))

230+

204 , testE "joinDyn" $ do

231 , testE "joinDyn" $ do

205 e <- events1

232 e <- events1

206 bb <- hold "b" e

233 bb <- hold "b" e

@@ -223,6 +250,38 @@ testCases =

223 d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2

250 d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2

224

251

225 return $ current $ zipDynWith (<>) d1 d2

252 return $ current $ zipDynWith (<>) d1 d2

253+

254+ , testB "buildDynamicStrictness" $ do

255+ rec

256+ d'' <- pushDyn return d'

257+ d' <- pushDyn return d

258+ d <- holdDyn "0" =<< events1

259+

260+ _ <- sample (current d'')

261+ return (current d'')

262+

263+ , testB "factorDyn" $ do

264+ d <- holdDyn (Left "a") =<< eithers

265+

266+ eithers <- eitherDyn d

267+ let unFactor = either id id

268+ return $ current (join (fmap unFactor eithers))

269+

270+ , testB "pushDynDeep" $ do

271+ e1 <- events1

272+ e2 <- events2

273+

274+ d1 <- holdDyn "d1" =<< events1

275+ d2 <- holdDyn "d2" =<< events2

276+

277+ d <- flip pushDyn d1 $ \a ->

278+ flip pushDyn d2 $ \b ->

279+ flip pushDyn d1 $ \c ->

280+ return (a <> b <> c)

281+

282+ d' <- pushDyn scanInnerDyns d >>= scanInnerDyns

283+ return $ current d'

284+

226 , testE "fan-1" $ do

285 , testE "fan-1" $ do

227 e <- fmap toMap <$> events1

286 e <- fmap toMap <$> events1

228 let es = select (fanMap e) . Const2 <$> values

287 let es = select (fanMap e) . Const2 <$> values

@@ -264,14 +323,18 @@ testCases =

264 return $ void e

323 return $ void e

265 lazyHold

324 lazyHold

266

325

326+

267 ] where

327 ] where

268

328

269 events1, events2, events3 :: TestPlan t m => m (Event t String)

329 events1, events2, events3 :: TestPlan t m => m (Event t String)

270 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]

330 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]

271 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]

331 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]

272−

273 events3 = liftA2 mappend events1 events2

332 events3 = liftA2 mappend events1 events2

274

333

334+ eithers :: TestPlan t m => m (Event t (Either String String))

335+ eithers = plan [(1, Left "e"), (3, Left "d"), (4, Right "c"), (6, Right "b"), (7, Left "a")]

336+

337+

275 values = "abcde"

338 values = "abcde"

276 toMap str = Map.fromList $ map (\c -> (c, c)) str

339 toMap str = Map.fromList $ map (\c -> (c, c)) str

277

340

@@ -281,5 +344,3 @@ testCases =

281

344

282 deep e = leftmost [e, e]

345 deep e = leftmost [e, e]

283 leftmost2 e1 e2 = leftmost [e1, e2]

346 leftmost2 e1 e2 = leftmost [e1, e2]

284−

285−

test/Test/Run.hs+8

@@ -64,3 +64,11 @@ runApp' :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)

64runApp' app input = do

65 let app' = fmap (AppOut (pure ())) . app

66 map (map snd) <$> runApp (app' . _appIn_event) () (map (fmap That) input)

67+

68+runAppB :: (t ~ SpiderTimeline Global, m ~ SpiderHost Global)

69+ => (Event t eIn -> PerformEventT t m (Behavior t bOut))

70+ -> [Maybe eIn]

71+ -> IO [[bOut]]

72+runAppB app input = do

73+ let app' = fmap (flip AppOut never) . app

74+ map (map fst) <$> runApp (app' . _appIn_event) () (map (fmap That) input)

test/semantics.hs−2

@@ -45,5 +45,3 @@ main = do

45 ]

46

47 makeGroup name tests = first (\test -> intercalate "/" [name, test]) <$> tests

48−

49−