4e930a4 · patch · git.iko.soy

git.iko.soy/patch

Fix hlint warnings

commit4e930a42f43e2594969bab1f6bc6de7684158c2e authorRyan Trinkle <ryan.trinkle@gmail.com> dateSun 17 Jul 2016, 20:38 (10 years ago) parent43634f3

19 files changed+143−167

compare with develop

unifiedsplit

bench/Main.hs+1−1 bench/RunAll.hs+2−2 reflex.cabal+8−2 src/Data/Functor/Misc.hs+1−1 src/Data/WeakBag.hs−1 src/Reflex.hs+6−11 src/Reflex/Class.hs+10−16 src/Reflex/Dynamic.hs+2−10 src/Reflex/Host/Class.hs+2−5 src/Reflex/Spider/Internal.hs+63−69 test/Reflex/Bench/Focused.hs+2−3 test/Reflex/Plan/Reflex.hs−2 test/Reflex/Pure.hs+6−9 test/Reflex/Test.hs−1 test/Reflex/Test/CrossImpl.hs+18−22 test/Reflex/Test/Micro.hs+6−7 test/Reflex/Test/RunAll.hs−1 test/Reflex/TestPlan.hs−4 test/hlint.hs+16

bench/Main.hs+1−1

@@ -96,7 +96,7 @@ setupMerge :: Int

9696 )

9797setupMerge num = do

9898 (evs, triggers) <- unzip <$> replicateM num newEventWithTriggerRef

99− let !m = DMap.fromList [(Const2 i) :=> v | (i,v) <- zip [0..] evs]

99+ let !m = DMap.fromList [Const2 i :=> v | (i,v) <- zip [0..] evs]

100100 pure (merge m, triggers)

101101

102102subscribePair :: (Event (SpiderEnv Global) a, b) -> SpiderHost Global (EventHandle (SpiderEnv Global) a, b)

bench/RunAll.hs+2−2

@@ -81,7 +81,7 @@ instance NFData (Behavior t a) where

8181 rnf !_ = ()

8282

8383instance NFData (Firing t) where

84− rnf !(Firing _ _) = ()

84+ rnf !_ = ()

8585

8686-- Measure the running time

8787benchFiring :: forall t m. (MonadReflexHost' t m, MonadSample t m) => (forall a. m a -> IO a) -> TestCase -> Int -> IO ()

@@ -107,7 +107,7 @@ waitForFinalizers = do

107107 performGC

108108 fix $ \loop -> do

109109 f <- readIORef isFinalized

110− if f then return () else do

110+ unless f $ do

111111 threadDelay 1

112112 loop

113113

reflex.cabal+8−2

@@ -82,7 +82,7 @@ benchmark spider-bench

8282 dependent-sum,

8383 dependent-map,

8484 transformers >= 0.3,

85− stm == 2.4.*,

85+ stm,

8686 deepseq >= 1.3 && < 1.5,

8787 mtl,

8888 primitive,

@@ -104,7 +104,7 @@ benchmark saulzar-bench

104104 dependent-sum,

105105 dependent-map,

106106 transformers >= 0.3,

107− stm == 2.4.*,

107+ stm,

108108 deepseq >= 1.3 && < 1.5,

109109 mtl,

110110 primitive,

@@ -115,6 +115,12 @@ benchmark saulzar-bench

115115 loch-th,

116116 process

117117

118+test-suite hlint

119+ build-depends: base, hlint == 1.9.*

120+ hs-source-dirs: test

121+ main-is: hlint.hs

122+ type: exitcode-stdio-1.0

123+

118124source-repository head

119125 type: git

120126 location: https://github.com/reflex-frp/reflex

src/Data/Functor/Misc.hs+1−1

@@ -25,7 +25,7 @@ data WrapArg :: (k -> *) -> (k -> *) -> * -> * where

2525 WrapArg :: f a -> WrapArg g f (g a)

2626

2727instance GEq f => GEq (WrapArg g f) where

28− geq (WrapArg a) (WrapArg b) = fmap (\Refl -> Refl) $ geq a b

28+ geq (WrapArg a) (WrapArg b) = (\Refl -> Refl) <$> geq a b

2929

3030instance GCompare f => GCompare (WrapArg g f) where

3131 gcompare (WrapArg a) (WrapArg b) = case gcompare a b of

src/Data/WeakBag.hs−1

@@ -1,4 +1,3 @@

1−{-# LANGUAGE BangPatterns #-}

21module Data.WeakBag (WeakBag, WeakBagTicket, empty, singleton, insert, Data.WeakBag.traverse, remove) where

43import Control.Concurrent.STM

src/Reflex.hs+6−11

@@ -1,12 +1,7 @@

1−module Reflex ( module Reflex.Class

2− , module Reflex.Dynamic

3− , module Reflex.Dynamic.Nub

4− , module Reflex.Dynamic.TH

5− , module Reflex.Spider

6− ) where

1+module Reflex (module X) where

8−import Reflex.Class

9−import Reflex.Dynamic

10−import Reflex.Dynamic.Nub

11−import Reflex.Dynamic.TH

12−import Reflex.Spider

3+import Reflex.Class as X

4+import Reflex.Dynamic as X

5+import Reflex.Dynamic.Nub as X

6+import Reflex.Dynamic.TH as X

7+import Reflex.Spider as X

src/Reflex/Class.hs+10−16

@@ -1,20 +1,14 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

3−{-# LANGUAGE EmptyDataDecls #-}

42{-# LANGUAGE FlexibleContexts #-}

53{-# LANGUAGE FlexibleInstances #-}

64{-# LANGUAGE FunctionalDependencies #-}

75{-# LANGUAGE GADTs #-}

8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

96{-# LANGUAGE LambdaCase #-}

107{-# LANGUAGE MultiParamTypeClasses #-}

118{-# LANGUAGE NoMonomorphismRestriction #-}

12−{-# LANGUAGE PackageImports #-}

139{-# LANGUAGE RankNTypes #-}

1410{-# LANGUAGE RecursiveDo #-}

1511{-# LANGUAGE ScopedTypeVariables #-}

16−{-# LANGUAGE StandaloneDeriving #-}

17−{-# LANGUAGE TemplateHaskell #-}

1812{-# LANGUAGE TypeFamilies #-}

1913{-# LANGUAGE TypeOperators #-}

2014{-# LANGUAGE UndecidableInstances #-}

@@ -128,7 +122,7 @@ instance GCompare k => Monoid (PatchDMap (DMap k v)) where

128122

129123instance Patch PatchDMap where

130124 apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

131− where insertions = DMap.mapMaybeWithKey (const $ id . getCompose) diff

125+ where insertions = DMap.mapMaybeWithKey (const $ getCompose) diff

132126 deletions = DMap.mapMaybeWithKey (const $ nothingToJust . getCompose) diff

133127 nothingToJust = \case

134128 Nothing -> Just $ Constant ()

@@ -215,14 +209,14 @@ instance MonadHold t m => MonadHold t (ContT r m) where

215209-- | Create an Event from another Event.

216210-- The provided function can sample 'Behavior's and hold 'Event's.

217211pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b

218−pushAlways f = push (liftM Just . f)

212+pushAlways f = push (fmap Just . f)

219213

220214-- | Flipped version of 'fmap'.

221215ffor :: Functor f => f a -> (a -> b) -> f b

222216ffor = flip fmap

223217

224218instance Reflex t => Functor (Behavior t) where

225− fmap f = pull . liftM f . sample

219+ fmap f = pull . fmap f . sample

226220

227221instance Reflex t => Applicative (Behavior t) where

228222 pure = constant

@@ -238,7 +232,7 @@ instance Reflex t => Monad (Behavior t) where

238232

239233instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where

240234 a <> b = pull $ liftM2 (<>) (sample a) (sample b)

241− sconcat = pull . liftM sconcat . mapM sample

235+ sconcat = pull . fmap sconcat . mapM sample

242236#if MIN_VERSION_semigroups(0,17,0)

243237 stimes n = fmap $ stimes n

244238#else

@@ -248,7 +242,7 @@ instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where

248242instance (Reflex t, Monoid a) => Monoid (Behavior t a) where

249243 mempty = constant mempty

250244 mappend a b = pull $ liftM2 mappend (sample a) (sample b)

251− mconcat = pull . liftM mconcat . mapM sample

245+ mconcat = pull . fmap mconcat . mapM sample

252246

253247--TODO: See if there's a better class in the standard libraries already

254248-- | A class for values that combines filtering and mapping using 'Maybe'.

@@ -293,7 +287,7 @@ attachWith f = attachWithMaybe $ \a b -> Just $ f a b

293287-- value of the 'Behavior'. The occurrence is discarded if the combining function

294288-- returns Nothing

295289attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c

296−attachWithMaybe f b e = flip push e $ \o -> liftM (flip f o) $ sample b

290+attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b

297291

298292-- | Alias for 'headE'

299293onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

@@ -311,7 +305,7 @@ headE e = do

311305-- | Create a new 'Event' that occurs on all but the first occurence

312306-- of the supplied 'Event'.

313307tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

314−tailE e = liftM snd $ headTailE e

308+tailE e = snd <$> headTailE e

315309

316310-- | Create a tuple of two 'Event's with the first one occuring only

317311-- the first time the supplied 'Event' occurs and the second occuring

@@ -400,9 +394,9 @@ appendEvents e1 e2 = mergeThese mappend <$> align e1 e2

400394{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}

401395sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)

402396sequenceThese t = case t of

403− This ma -> liftM This ma

397+ This ma -> fmap This ma

404398 These ma mb -> liftM2 These ma mb

405− That mb -> liftM That mb

399+ That mb -> fmap That mb

406400

407401instance (Semigroup a, Reflex t) => Semigroup (Event t a) where

408402 (<>) = alignWith (mergeThese (<>))

@@ -425,7 +419,7 @@ mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

425419mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)

426420 . merge

427421 . DMap.fromDistinctAscList

428− . map (\(k, v) -> (Const2 k) :=> v)

422+ . map (\(k, v) -> Const2 k :=> v)

429423 $ zip [0 :: Int ..] es

430424

431425-- | Create a new 'Event' that occurs if at least one of the 'Event's

src/Reflex/Dynamic.hs+2−10

@@ -1,22 +1,14 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE DeriveDataTypeable #-}

4−{-# LANGUAGE EmptyDataDecls #-}

53{-# LANGUAGE FlexibleContexts #-}

64{-# LANGUAGE FlexibleInstances #-}

7−{-# LANGUAGE FunctionalDependencies #-}

85{-# LANGUAGE GADTs #-}

9−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

106{-# LANGUAGE LambdaCase #-}

117{-# LANGUAGE MultiParamTypeClasses #-}

128{-# LANGUAGE NoMonomorphismRestriction #-}

13−{-# LANGUAGE PackageImports #-}

149{-# LANGUAGE PolyKinds #-}

1510{-# LANGUAGE RankNTypes #-}

16−{-# LANGUAGE RecursiveDo #-}

1711{-# LANGUAGE ScopedTypeVariables #-}

18−{-# LANGUAGE StandaloneDeriving #-}

19−{-# LANGUAGE TemplateHaskell #-}

2012{-# LANGUAGE TypeFamilies #-}

2113{-# LANGUAGE TypeOperators #-}

2214{-# LANGUAGE UndecidableInstances #-}

@@ -105,7 +97,7 @@ class HBuild' l r where

10597

10698instance (l' ~ HRevApp l '[])

10799 => HBuild' l (HList l') where

108− hBuild' l = hReverse l

100+ hBuild' = hReverse

109101

110102instance HBuild' (a ': l) r

111103 => HBuild' l (a->r) where

@@ -360,7 +352,7 @@ fhlistToDMap = DMap.fromList . go

360352 where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]

361353 go = \case

362354 FHNil -> []

363− FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> (HTailPtr p) :=> v) (go t)

355+ FHCons h t -> (HHeadPtr :=> h) : map (\(p :=> v) -> HTailPtr p :=> v) (go t)

364356

365357class RebuildSortedHList l where

366358 rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l

src/Reflex/Host/Class.hs+2−5

@@ -1,13 +1,10 @@

1−{-# LANGUAGE EmptyDataDecls #-}

21{-# LANGUAGE ExistentialQuantification #-}

32{-# LANGUAGE FlexibleContexts #-}

43{-# LANGUAGE FlexibleInstances #-}

54{-# LANGUAGE FunctionalDependencies #-}

65{-# LANGUAGE GADTs #-}

7−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

86{-# LANGUAGE MultiParamTypeClasses #-}

97{-# LANGUAGE RankNTypes #-}

10−{-# LANGUAGE RecursiveDo #-}

118{-# LANGUAGE RoleAnnotations #-}

129{-# LANGUAGE ScopedTypeVariables #-}

1310{-# LANGUAGE TypeFamilies #-}

@@ -98,7 +95,7 @@ class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, Mona

9895 -- The main loop waits for external events to happen (such as keyboard input or a mouse click)

9996 -- and then fires the corresponding events using this function. The read callback can be used

10097 -- to read output events and perform a corresponding response action to the external event.

101− fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> (ReadPhase m a) -> m a

98+ fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a

10299

103100 -- | Run a frame without any events firing.

104101 --

@@ -145,7 +142,7 @@ fireEventRefAndRead mtRef input e = do

145142 mGetValue <- readEvent e

146143 case mGetValue of

147144 Nothing -> return Nothing

148− Just getValue -> liftM Just getValue

145+ Just getValue -> fmap Just getValue

149146

150147

151148--------------------------------------------------------------------------------

src/Reflex/Spider/Internal.hs+63−69

@@ -13,12 +13,10 @@

1313{-# LANGUAGE MultiParamTypeClasses #-}

1414{-# LANGUAGE MultiWayIf #-}

1515{-# LANGUAGE RankNTypes #-}

16−{-# LANGUAGE RecursiveDo #-}

1716{-# LANGUAGE RoleAnnotations #-}

1817{-# LANGUAGE ScopedTypeVariables #-}

1918{-# LANGUAGE TypeFamilies #-}

2019{-# LANGUAGE TypeOperators #-}

21−{-# LANGUAGE UnboxedTuples #-}

2220{-# LANGUAGE UndecidableInstances #-}

2321module Reflex.Spider.Internal (Spider, SpiderEnv (..), Global, SpiderHost, runSpiderHost, SpiderEventHandle (..), showSubscriberType, showEventType, ComputeM (..), MergeSubscribedParent (..), HasSpiderEnv (..), newSpiderEnv, SpiderPullM (..), SpiderPushM (..), ReadPhase (..)) where

2422

@@ -322,7 +320,7 @@ getHoldEventSubscription h = do

322320 v <- liftIO $ evaluate $ holdValue h

323321 i <- liftIO $ evaluate $ holdInvalidators h

324322 defer $ SomeAssignment v i new

325− liftIO $ writeIORef (holdParent h) $! Right subscription

323+ liftIO $ writeIORef (holdParent h) $ Right subscription

326324 return subscription

327325

328326type BehaviorEnv = (Maybe (Weak Invalidator, IORef [SomeBehaviorSubscribed]), IORef [SomeHoldInit])

@@ -534,6 +532,7 @@ data Switch a

534532 , switchSubscribed :: !(IORef (Maybe (SwitchSubscribed a)))

535533 }

536534

535+{-# ANN CoincidenceSubscribed "HLint: ignore Redundant bracket" #-}

537536data CoincidenceSubscribed a

538537 = CoincidenceSubscribed { coincidenceSubscribedCachedSubscribed :: !(IORef (Maybe (CoincidenceSubscribed a)))

539538 , coincidenceSubscribedOccurrence :: !(IORef (Maybe a))

@@ -706,10 +705,10 @@ updated = \case

706705 DynamicDynIdentity d -> EventDynIdentity d

707706

708707newMapDyn :: (a -> b) -> Dynamic Identity a -> Dynamic Identity b

709−newMapDyn f d = DynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ current d) (fmap (Identity . f . runIdentity) $ updated d)

708+newMapDyn f d = DynamicDynIdentity $ unsafeDyn (fmap f $ readBehaviorTracked $ current d) (Identity . f . runIdentity <$> updated d)

710709

711710instance Functor (Dynamic Identity) where

712− fmap f d = newMapDyn f d

711+ fmap = newMapDyn

713712

714713instance Applicative (Dynamic Identity) where

715714 pure = DynamicConst

@@ -760,8 +759,8 @@ newJoinDyn :: Dynamic Identity (Dynamic Identity a) -> Dyn Identity a

760759newJoinDyn d =

761760 let readV0 = readBehaviorTracked . current =<< readBehaviorTracked (current d)

762761 eOuter = push (fmap (Just . Identity) . readBehaviorUntracked . current . runIdentity) $ updated d

763− eInner = switch $ fmap updated $ current d

764− eBoth = coincidence $ fmap (updated . runIdentity) $ updated d

762+ eInner = switch $ updated <$> current d

763+ eBoth = coincidence $ updated . runIdentity <$> updated d

765764 v' = unSpiderEvent $ R.leftmost $ map SpiderEvent [eBoth, eOuter, eInner]

766765 in unsafeDyn readV0 v'

767766

@@ -785,7 +784,7 @@ instance Functor Event where

785784 fmap f = push $ return . Just . f

786785

787786instance Functor Behavior where

788− fmap f = pull . liftM f . readBehaviorTracked

787+ fmap f = pull . fmap f . readBehaviorTracked

789788

790789{-# NOINLINE push #-} --TODO: If this is helpful, we can get rid of the unsafeNewIORef and use unsafePerformIO directly

791790push :: forall a b. (a -> ComputeM (Maybe b)) -> Event a -> Event b

@@ -859,7 +858,7 @@ run roots after = do

859858 m <- liftIO $ readIORef $ mergeSubscribedAccum subscribed

860859 liftIO $ writeIORef (mergeSubscribedAccum subscribed) $! DMap.empty

861860 --TODO: Assert that m is not empty

862− liftIO $ writeIORef (mergeSubscribedOccurrence subscribed) $! Just m

861+ liftIO $ writeIORef (mergeSubscribedOccurrence subscribed) $ Just m

863862 scheduleClear $ mergeSubscribedOccurrence subscribed

864863 propagateAndUpdateSubscribersRef (mergeSubscribedSubscribers subscribed) m

865864 go

@@ -1022,7 +1021,7 @@ propagate a subscribers = withIncreasedDepth $ do

10221021 SubscriberHoldIdentity h -> {-# SCC "traverseHoldIdentity" #-} propagateSubscriberHold h a

10231022 SubscriberSwitch subscribed -> {-# SCC "traverseSwitch" #-} do

10241023 tracePropagate $ "SubscriberSwitch" <> showNodeId subscribed

1025− liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $! Just a

1024+ liftIO $ writeIORef (switchSubscribedOccurrence subscribed) $ Just a

10261025 scheduleClear $ switchSubscribedOccurrence subscribed

10271026 propagate a $ switchSubscribedSubscribers subscribed

10281027 SubscriberCoincidenceOuter subscribed -> {-# SCC "traverseCoincidenceOuter" #-} do

@@ -1032,7 +1031,7 @@ propagate a subscribers = withIncreasedDepth $ do

10321031 (occ, innerHeight, innerSubd) <- subscribeCoincidenceInner a outerHeight subscribed

10331032 tracePropagate $ " isJust occ = " <> show (isJust occ)

10341033 tracePropagate $ " innerHeight = " <> show innerHeight

1035− liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $! Just innerSubd

1034+ liftIO $ writeIORef (coincidenceSubscribedInnerParent subscribed) $ Just innerSubd

10361035 scheduleClear $ coincidenceSubscribedInnerParent subscribed

10371036 case occ of

10381037 Nothing -> do

@@ -1050,7 +1049,7 @@ propagate a subscribers = withIncreasedDepth $ do

10501049 case occ of

10511050 Just _ -> return () -- SubscriberCoincidenceOuter must have already propagated this event

10521051 Nothing -> do

1053− liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $! Just a

1052+ liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) $ Just a

10541053 scheduleClear $ coincidenceSubscribedOccurrence subscribed

10551054 propagate a $ coincidenceSubscribedSubscribers subscribed

10561055 SubscriberHandle -> {-# SCC "traverseHandle" #-} tracePropagate "SubscriberHandle"

@@ -1094,13 +1093,13 @@ runBehaviorM :: BehaviorM a -> Maybe (Weak Invalidator, IORef [SomeBehaviorSubsc

10941093runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)

10951094

10961095askInvalidator :: BehaviorM (Maybe (Weak Invalidator))

1097−askInvalidator = liftM (fmap fst . fst) $ BehaviorM ask

1096+askInvalidator = fmap fst . fst <$> BehaviorM ask

10981097

10991098askParentsRef :: BehaviorM (Maybe (IORef [SomeBehaviorSubscribed]))

1100−askParentsRef = liftM (fmap snd . fst) $ BehaviorM ask

1099+askParentsRef = fmap snd . fst <$> BehaviorM ask

11011100

11021101askBehaviorHoldInits :: BehaviorM (IORef [SomeHoldInit])

1103−askBehaviorHoldInits = liftM snd $ BehaviorM ask

1102+askBehaviorHoldInits = snd <$> BehaviorM ask

11041103

11051104readBehaviorTracked :: Behavior a -> BehaviorM a

11061105readBehaviorTracked b = case b of

@@ -1129,7 +1128,7 @@ readBehaviorTracked b = case b of

11291128 , pullSubscribedOwnInvalidator = i

11301129 , pullSubscribedParents = parents

11311130 }

1132− liftIO $ writeIORef (pullValue p) $! Just subscribed

1131+ liftIO $ writeIORef (pullValue p) $ Just subscribed

11331132 askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))

11341133 return a

11351134 BehaviorDyn d -> readHoldTracked =<< getDynHold d

@@ -1153,13 +1152,13 @@ getDynHold d = do

11531152 holdInits <- getDeferralQueue

11541153 v0 <- liftIO $ runBehaviorM readV0 Nothing holdInits

11551154 h <- hold v0 v'

1156− liftIO $ writeIORef (unDyn d) $! Right h

1155+ liftIO $ writeIORef (unDyn d) $ Right h

11571156 return h

11581157

11591158{-

11601159readEvent :: Event a -> ResultM (Maybe a)

11611160readEvent e = case e of

1162− EventRoot k r -> liftIO . liftM (coerce . DMap.lookup k) . readIORef $ rootOccurrence r

1161+ EventRoot k r -> liftIO . fmap (coerce . DMap.lookup k) . readIORef $ rootOccurrence r

11631162 EventNever -> return Nothing

11641163 EventPush p -> do

11651164 subscribed <- getPushSubscribed p

@@ -1266,25 +1265,25 @@ subscribeEventSubscribed :: EventSubscribed a -> Subscriber a -> IO (Maybe (Subs

12661265subscribeEventSubscribed es sub = case es of

12671266 EventSubscribedRoot r -> do

12681267 traceSubscribe $ "subscribeEventSubscribed Root"

1269− fmap Just $ subscribeRootSubscribed r sub

1268+ Just <$> subscribeRootSubscribed r sub

12701269 EventSubscribedNever -> do

12711270 traceSubscribe $ "subscribeEventSubscribed Never"

12721271 return Nothing

12731272 EventSubscribedPush subscribed -> do

12741273 traceSubscribe $ "subscribeEventSubscribed Push"

1275− fmap Just $ subscribePushSubscribed subscribed sub

1274+ Just <$> subscribePushSubscribed subscribed sub

12761275 EventSubscribedFan k subscribed -> do

12771276 traceSubscribe $ "subscribeEventSubscribed Fan"

1278− fmap Just $ subscribeFanSubscribed k subscribed sub

1277+ Just <$> subscribeFanSubscribed k subscribed sub

12791278 EventSubscribedMerge subscribed -> do

12801279 traceSubscribe $ "subscribeEventSubscribed Merge"

1281− fmap Just $ subscribeMergeSubscribed subscribed sub

1280+ Just <$> subscribeMergeSubscribed subscribed sub

12821281 EventSubscribedSwitch subscribed -> do

12831282 traceSubscribe $ "subscribeEventSubscribed Switch"

1284− fmap Just $ subscribeSwitchSubscribed subscribed sub

1283+ Just <$> subscribeSwitchSubscribed subscribed sub

12851284 EventSubscribedCoincidence subscribed -> do

12861285 traceSubscribe $ "subscribeEventSubscribed Coincidence"

1287− fmap Just $ subscribeCoincidenceSubscribed subscribed sub

1286+ Just <$> subscribeCoincidenceSubscribed subscribed sub

12881287

12891288{-# INLINE eventSubscribedHeightRef #-}

12901289eventSubscribedHeightRef :: EventSubscribed a -> IORef Height

@@ -1317,7 +1316,7 @@ eventSubscribedGetParents = \case

13171316 EventSubscribedFan _ subscribed -> return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

13181317 EventSubscribedMerge subscribed -> do

13191318 ps <- readIORef $ mergeSubscribedParents subscribed

1320− return $ fmap (\(_ :=> v) -> Some.This $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription v) $ DMap.toList ps

1319+ return $ R.ffor (DMap.toList ps) $ \(_ :=> v) -> Some.This $ _eventSubscription_subscribed $ mergeSubscribedParentSubscription v

13211320 EventSubscribedSwitch subscribed -> do

13221321 s <- readIORef $ switchSubscribedCurrentParent subscribed

13231322 return [Some.This $ _eventSubscription_subscribed s]

@@ -1354,7 +1353,7 @@ getRootSubscribed k r sub = do

13541353 let subscribed = RootSubscribed

13551354 { rootSubscribedKey = k

13561355 , rootSubscribedCachedSubscribed = cached

1357− , rootSubscribedOccurrence = liftM (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r

1356+ , rootSubscribedOccurrence = fmap (coerce . DMap.lookup k) $ readIORef $ rootOccurrence r

13581357 , rootSubscribedSubscribers = subs

13591358 , rootSubscribedUninit = uninit

13601359 , rootSubscribedWeakSelf = weakSelf

@@ -1366,6 +1365,7 @@ getRootSubscribed k r sub = do

13661365 modifyIORef' (rootSubscribed r) $ DMap.insertWith (error $ "getRootSubscribed: duplicate key inserted into Root") k subscribed --TODO: I think we can just write back mSubscribed rather than re-reading it

13671366 return (sln, subscribed)

13681367

1368+{-# ANN cleanupRootSubscribed "HLint: ignore Redundant bracket" #-}

13691369cleanupRootSubscribed :: RootSubscribed a -> IO ()

13701370cleanupRootSubscribed self@(RootSubscribed { rootSubscribedKey = k, rootSubscribedCachedSubscribed = cached }) = do

13711371 rootSubscribedUninit self

@@ -1390,7 +1390,7 @@ getPushSubscribed p sub = do

13901390 s <- liftIO $ newSubscriberPush (pushCompute p) subscribedUnsafe

13911391 subscription@(EventSubscription _ subd) <- subscribe (pushParent p) s

13921392 parentOcc <- liftIO $ readEventSubscribed subd

1393− occ <- runComputeM $ liftM join $ mapM (pushCompute p) parentOcc

1393+ occ <- runComputeM $ join <$> mapM (pushCompute p) parentOcc

13941394 occRef <- liftIO $ newIORef occ

13951395 when (isJust occ) $ scheduleClear occRef

13961396 weakSelf <- liftIO $ newIORef $ error "getPushSubscribed: weakSelf not initialized"

@@ -1410,13 +1410,13 @@ getPushSubscribed p sub = do

14101410 }

14111411 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "PushSubscribed"

14121412 liftIO $ writeIORef subscribedRef $! subscribed

1413− liftIO $ writeIORef (pushSubscribed p) $! Just subscribed

1413+ liftIO $ writeIORef (pushSubscribed p) $ Just subscribed

14141414 return (sln, subscribed)

14151415

14161416cleanupPushSubscribed :: PushSubscribed a b -> IO ()

14171417cleanupPushSubscribed self = do

14181418 unsubscribe $ pushSubscribedParent self

1419− writeIORef (pushSubscribedCachedSubscribed self) $! Nothing

1419+ writeIORef (pushSubscribedCachedSubscribed self) $ Nothing

14201420

14211421{-# INLINE subscribePushSubscribed #-}

14221422subscribePushSubscribed :: PushSubscribed a b -> Subscriber b -> IO (SubscriberListTicket b)

@@ -1439,18 +1439,18 @@ getMergeSubscribed m sub = do

14391439 subscription@(EventSubscription _ parentSubd) <- subscribe e s

14401440 parentOcc <- liftIO $ readEventSubscribed parentSubd

14411441 height <- liftIO $ readIORef $ eventSubscribedHeightRef parentSubd

1442− return $ (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> (MergeSubscribedParent subscription s))

1443− let dm = DMap.fromDistinctAscList $ catMaybes $ map (\(x, _, _) -> x) subscribers

1442+ return $ (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription s)

1443+ let dm = DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

14441444 heights = fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

14451445 myHeightBag = heightBagFromList $ filter (/= invalidHeight) heights

1446− myHeight = if any (== invalidHeight) heights

1446+ myHeight = if invalidHeight `elem` heights

14471447 then invalidHeight

14481448 else succHeight $ heightBagMax myHeightBag

14491449 currentHeight <- getCurrentHeight

14501450 let (occ, accum) = if currentHeight >= myHeight -- If we should have fired by now

14511451 then (if DMap.null dm then Nothing else Just dm, DMap.empty)

14521452 else (Nothing, dm)

1453− when (not $ DMap.null accum) $ do

1453+ unless (DMap.null accum) $ do

14541454 scheduleMerge myHeight subscribedUnsafe

14551455 occRef <- liftIO $ newIORef occ

14561456 when (isJust occ) $ scheduleClear occRef

@@ -1478,7 +1478,7 @@ getMergeSubscribed m sub = do

14781478 defer $ SomeMergeInit subscribed $ updated $ mergeParents m

14791479 liftIO $ writeIORef subscribedRef $! subscribed

14801480 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "MergeSubscribed"

1481− liftIO $ writeIORef (mergeSubscribed m) $! Just subscribed

1481+ liftIO $ writeIORef (mergeSubscribed m) $ Just subscribed

14821482 return (sln, subscribed)

14831483

14841484cleanupMergeSubscribed :: MergeSubscribed k -> IO ()

@@ -1486,7 +1486,7 @@ cleanupMergeSubscribed subscribed = do

14861486 parents <- readIORef $ mergeSubscribedParents subscribed

14871487 forM_ (DMap.toList parents) $ \(_ :=> msp) -> unsubscribe $ mergeSubscribedParentSubscription msp

14881488 -- Not necessary, because this whole MergeSubscribed is dead: writeIORef (mergeSubscribedParents subscribed) DMap.empty

1489− writeIORef (mergeSubscribedCachedSubscribed subscribed) $! Nothing -- Get rid of the cached subscribed

1489+ writeIORef (mergeSubscribedCachedSubscribed subscribed) $ Nothing -- Get rid of the cached subscribed

14901490

14911491{-# INLINE subscribeMergeSubscribed #-}

14921492subscribeMergeSubscribed :: MergeSubscribed k -> Subscriber (DMap k Identity) -> IO (SubscriberListTicket (DMap k Identity))

@@ -1520,7 +1520,7 @@ getFanSubscribed k f sub = do

15201520 liftIO $ writeIORef subscribersRef $! DMap.singleton k $ FanSubscribedChildren subsForK self weakSelf

15211521 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug self "FanSubscribed"

15221522 liftIO $ writeIORef subscribedRef $! subscribed

1523− liftIO $ writeIORef (fanSubscribed f) $! Just subscribed

1523+ liftIO $ writeIORef (fanSubscribed f) $ Just subscribed

15241524 return (slnForSub, subscribed)

15251525

15261526cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed k) -> IO ()

@@ -1531,7 +1531,7 @@ cleanupFanSubscribed (k, subscribed) = do

15311531 then do

15321532 unsubscribe $ fanSubscribedParent subscribed

15331533 -- Not necessary in this case, because this whole FanSubscribed is dead: writeIORef (fanSubscribedSubscribers subscribed) reducedSubscribers

1534− writeIORef (fanSubscribedCachedSubscribed subscribed) $! Nothing

1534+ writeIORef (fanSubscribedCachedSubscribed subscribed) Nothing

15351535 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

15361536

15371537{-# INLINE subscribeFanSubscribed #-}

@@ -1590,14 +1590,14 @@ getSwitchSubscribed s sub = do

15901590 }

15911591 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"

15921592 liftIO $ writeIORef subscribedRef $! subscribed

1593− liftIO $ writeIORef (switchSubscribed s) $! Just subscribed

1593+ liftIO $ writeIORef (switchSubscribed s) $ Just subscribed

15941594 return (slnForSub, subscribed)

15951595

15961596cleanupSwitchSubscribed :: SwitchSubscribed a -> IO ()

15971597cleanupSwitchSubscribed subscribed = do

15981598 unsubscribe =<< readIORef (switchSubscribedCurrentParent subscribed)

15991599 finalize =<< readIORef (switchSubscribedOwnWeakInvalidator subscribed) -- We don't need to get invalidated if we're dead

1600− writeIORef (switchSubscribedCachedSubscribed subscribed) $! Nothing

1600+ writeIORef (switchSubscribedCachedSubscribed subscribed) Nothing

16011601

16021602{-# INLINE subscribeSwitchSubscribed #-}

16031603subscribeSwitchSubscribed :: SwitchSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)

@@ -1645,13 +1645,13 @@ getCoincidenceSubscribed c sub = do

16451645 }

16461646 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"

16471647 liftIO $ writeIORef subscribedRef $! subscribed

1648− liftIO $ writeIORef (coincidenceSubscribed c) $! Just subscribed

1648+ liftIO $ writeIORef (coincidenceSubscribed c) $ Just subscribed

16491649 return (slnForSub, subscribed)

16501650

16511651cleanupCoincidenceSubscribed :: CoincidenceSubscribed a -> IO ()

16521652cleanupCoincidenceSubscribed subscribed = do

16531653 unsubscribe $ coincidenceSubscribedOuterParent subscribed

1654− writeIORef (coincidenceSubscribedCachedSubscribed subscribed) $! Nothing

1654+ writeIORef (coincidenceSubscribedCachedSubscribed subscribed) Nothing

16551655

16561656{-# INLINE subscribeCoincidenceSubscribed #-}

16571657subscribeCoincidenceSubscribed :: CoincidenceSubscribed a -> Subscriber a -> IO (SubscriberListTicket a)

@@ -1674,33 +1674,27 @@ fan e =

16741674 }

16751675 in EventSelector $ \k -> EventFan k f

16761676

1677−{- SPECIALIZE runHoldInits :: IORef [SomeHoldInit] -> IORef [SomeMergeInit] -> EventM x () #-}

1678−--runHoldInits :: (CanSubscribe x m, Defer SomeMergeUpdate m) => IORef [SomeHoldInit] -> IORef [SomeMergeInit] -> m ()

16791677runHoldInits :: IORef [SomeHoldInit] -> IORef [SomeMergeInit] -> EventM x ()

16801678runHoldInits holdInitRef mergeInitRef = do

16811679 holdInits <- liftIO $ readIORef holdInitRef

16821680 mergeInits <- liftIO $ readIORef mergeInitRef

1683− if null holdInits && null mergeInits then return () else do

1684− liftIO $ writeIORef holdInitRef $! []

1685− liftIO $ writeIORef mergeInitRef $! []

1681+ unless (null holdInits && null mergeInits) $ do

1682+ liftIO $ writeIORef holdInitRef []

1683+ liftIO $ writeIORef mergeInitRef []

16861684 mapM_ initHold holdInits

16871685 mapM_ initMerge mergeInits

16881686 runHoldInits holdInitRef mergeInitRef

16891687

1690−{- SPECIALIZE initHold :: SomeHoldInit -> EventM x () #-}

1691−--initHold :: CanSubscribe x m => SomeHoldInit -> m ()

16921688initHold :: SomeHoldInit -> EventM x ()

16931689initHold (SomeHoldInit h) = void $ getHoldEventSubscription h

16941690

1695−{- SPECIALIZE initMerge :: SomeMergeInit -> EventM x () #-}

1696−--initMerge :: (CanSubscribe x m, Defer SomeMergeUpdate m) => SomeMergeInit -> m ()

16971691initMerge :: SomeMergeInit -> EventM x ()

16981692initMerge (SomeMergeInit subscribed changed) = do

16991693 changeSub <- liftIO $ newSubscriberMergeChange subscribed

17001694 EventSubscription _ changeSubd <- subscribe changed changeSub

17011695 change <- liftIO $ readEventSubscribed changeSubd

17021696 forM_ change $ \c -> defer $ SomeMergeUpdate c subscribed

1703− liftIO $ writeIORef (mergeSubscribedChange subscribed) $! (changeSub, changeSubd)

1697+ liftIO $ writeIORef (mergeSubscribedChange subscribed) (changeSub, changeSubd)

17041698

17051699-- | Run an event action outside of a frame

17061700runFrame :: EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex

@@ -1724,7 +1718,7 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do

17241718 return result

17251719 result <- runEventM go env

17261720 toClear <- readIORef toClearRef

1727− forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref $! Nothing

1721+ forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref Nothing

17281722 toClearRoot <- readIORef toClearRootRef

17291723 forM_ toClearRoot $ \(SomeRootClear ref) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty

17301724 toAssign <- readIORef toAssignRef

@@ -1735,7 +1729,7 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do

17351729 when debugInvalidate $ putStrLn $ "Invalidating Hold"

17361730 writeIORef iRef =<< evaluate =<< invalidate toReconnectRef =<< readIORef iRef

17371731 mergeUpdates <- readIORef mergeUpdateRef

1738− writeIORef mergeUpdateRef $! []

1732+ writeIORef mergeUpdateRef []

17391733 let updateMerge :: SomeMergeUpdate -> IO [SomeEventSubscription]

17401734 updateMerge (SomeMergeUpdate (R.PatchDMap p :: R.PatchDMap (DMap k Event)) m) = do

17411735 oldParents <- readIORef $ mergeSubscribedParents m

@@ -1768,15 +1762,15 @@ runFrame a = SpiderHost $ ask >>= \spiderEnv -> lift $ do

17681762 i <- evaluate $ switchSubscribedOwnInvalidator subscribed

17691763 wi' <- mkWeakPtrWithDebug i "wi'"

17701764 writeIORef (switchSubscribedOwnWeakInvalidator subscribed) $! wi'

1771− writeIORef (switchSubscribedBehaviorParents subscribed) $! []

1772− writeIORef holdInitRef $! [] --TODO: Should we reuse this?

1765+ writeIORef (switchSubscribedBehaviorParents subscribed) []

1766+ writeIORef holdInitRef [] --TODO: Should we reuse this?

17731767 e <- runBehaviorM (readBehaviorTracked (switchSubscribedParent subscribed)) (Just (wi', switchSubscribedBehaviorParents subscribed)) holdInitRef

17741768 runEventM (runHoldInits holdInitRef mergeInitRef) env --TODO: Is this actually OK? It seems like it should be, since we know that no events are firing at this point, but it still seems inelegant

17751769 --TODO: Make sure we touch the pieces of the SwitchSubscribed at the appropriate times

17761770 sub <- newSubscriberSwitch subscribed

17771771 subscription <- runReaderT (unSpiderHost (runFrame ({-# SCC "subscribeSwitch" #-} subscribe e sub))) spiderEnv --TODO: Assert that the event isn't firing --TODO: This should not loop because none of the events should be firing, but still, it is inefficient

17781772 {-

1779− stackTrace <- liftIO $ liftM renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)

1773+ stackTrace <- liftIO $ fmap renderStack $ ccsToStrings =<< (getCCSOf $! switchSubscribedParent subscribed)

17801774 liftIO $ putStrLn $ (++stackTrace) $ "subd' subscribed to " ++ case e of

17811775 EventRoot _ -> "EventRoot"

17821776 EventNever -> "EventNever"

@@ -1987,7 +1981,7 @@ invalidate toReconnectRef wis = do

19871981 traceInvalidate $ "invalidate: Pull" <> showNodeId p

19881982 mVal <- readIORef $ pullValue p

19891983 forM_ mVal $ \val -> do

1990− writeIORef (pullValue p) $! Nothing

1984+ writeIORef (pullValue p) Nothing

19911985 writeIORef (pullSubscribedInvalidators val) =<< evaluate =<< invalidate toReconnectRef =<< readIORef (pullSubscribedInvalidators val)

19921986 InvalidatorSwitch subscribed -> do

19931987 traceInvalidate $ "invalidate: Switch" <> showNodeId subscribed

@@ -2085,7 +2079,7 @@ instance R.Reflex (SpiderEnv x) where

20852079 {-# INLINABLE incrementalToDynamic #-}

20862080 incrementalToDynamic (SpiderIncremental i) = SpiderDynamic $ DynamicDynIdentity $ unsafeDyn (readBehaviorUntracked $ current i) $ flip push (updated i) $ \p -> do

20872081 c <- readBehaviorUntracked $ current i

2088− return $ fmap Identity $ R.apply p c --TODO: Avoid the redundant 'apply'

2082+ return $ Identity <$> R.apply p c --TODO: Avoid the redundant 'apply'

20892083

20902084instance R.MonadSample (SpiderEnv x) (EventM x) where

20912085 {-# INLINABLE sample #-}

@@ -2100,13 +2094,13 @@ instance R.MonadHold (SpiderEnv x) (EventM x) where

21002094 holdIncremental = holdIncrementalSpiderEventM

21012095

21022096holdSpiderEventM :: a -> R.Event (SpiderEnv x) a -> EventM x (R.Behavior (SpiderEnv x) a)

2103−holdSpiderEventM v0 e = liftM (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2097+holdSpiderEventM v0 e = fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

21042098

21052099holdDynSpiderEventM :: a -> R.Event (SpiderEnv x) a -> EventM x (R.Dynamic (SpiderEnv x) a)

2106−holdDynSpiderEventM v0 e = liftM (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2100+holdDynSpiderEventM v0 e = fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

21072101

21082102holdIncrementalSpiderEventM :: R.Patch p => a -> R.Event (SpiderEnv x) (p a) -> EventM x (R.Incremental (SpiderEnv x) p a)

2109−holdIncrementalSpiderEventM v0 e = liftM (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

2103+holdIncrementalSpiderEventM v0 e = fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

21102104

21112105instance R.MonadHold (SpiderEnv x) (SpiderHost x) where

21122106 {-# INLINABLE hold #-}

@@ -2132,9 +2126,9 @@ instance R.MonadHold (SpiderEnv x) (SpiderPushM x) where

21322126 {-# INLINABLE hold #-}

21332127 hold v0 e = R.current <$> R.holdDyn v0 e

21342128 {-# INLINABLE holdDyn #-}

2135− holdDyn v0 (SpiderEvent e) = SpiderPushM $ liftM (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity e

2129+ holdDyn v0 (SpiderEvent e) = SpiderPushM $ fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity e

21362130 {-# INLINABLE holdIncremental #-}

2137− holdIncremental v0 (SpiderEvent e) = SpiderPushM $ liftM (SpiderIncremental . DynamicHold) $ hold v0 e

2131+ holdIncremental v0 (SpiderEvent e) = SpiderPushM $ SpiderIncremental . DynamicHold <$> hold v0 e

21382132

21392133data RootTrigger a = forall k. GCompare k => RootTrigger (SubscriberList a, IORef (DMap k Identity), k a)

21402134newtype SpiderEventHandle a = SpiderEventHandle { unSpiderEventHandle :: EventSubscription a }

@@ -2152,7 +2146,7 @@ instance R.ReflexHost (SpiderEnv x) where

21522146

21532147instance R.MonadReadEvent (SpiderEnv x) (ReadPhase x) where

21542148 {-# INLINABLE readEvent #-}

2155− readEvent h = ReadPhase $ liftM (fmap return) $ liftIO $ do

2149+ readEvent h = ReadPhase $ fmap (fmap return) $ liftIO $ do

21562150 let EventSubscription sln subscribed = unSpiderEventHandle h

21572151 result <- readEventSubscribed subscribed

21582152 touch sln

@@ -2207,11 +2201,11 @@ addIdentity = unsafeCoerce

22072201

22082202instance R.MonadHold (SpiderEnv x) (SpiderHostFrame x) where

22092203 {-# INLINABLE hold #-}

2210− hold v0 e = SpiderHostFrame $ liftM (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2204+ hold v0 e = SpiderHostFrame $ fmap (SpiderBehavior . BehaviorHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

22112205 {-# INLINABLE holdDyn #-}

2212− holdDyn v0 e = SpiderHostFrame $ liftM (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

2206+ holdDyn v0 e = SpiderHostFrame $ fmap (SpiderDynamic . DynamicHoldIdentity) $ hold v0 $ addIdentity $ unSpiderEvent e

22132207 {-# INLINABLE holdIncremental #-}

2214− holdIncremental v0 e = SpiderHostFrame $ liftM (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

2208+ holdIncremental v0 e = SpiderHostFrame $ fmap (SpiderIncremental . DynamicHold) $ hold v0 $ unSpiderEvent e

22152209

22162210newEventWithTriggerIO :: forall a. (RootTrigger a -> IO (IO ())) -> IO (Event a)

22172211newEventWithTriggerIO f = do

@@ -2230,13 +2224,13 @@ newFanEventWithTriggerIO f = do

22302224 return $ EventSelector $ \k -> EventRoot k r

22312225

22322226instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHost x) where

2233− newEventWithTrigger = SpiderHost . lift . liftM SpiderEvent . newEventWithTriggerIO

2227+ newEventWithTrigger = SpiderHost . lift . fmap SpiderEvent . newEventWithTriggerIO

22342228 newFanEventWithTrigger f = SpiderHost $ lift $ do

22352229 es <- newFanEventWithTriggerIO f

22362230 return $ R.EventSelector $ SpiderEvent . select es

22372231

22382232instance R.MonadReflexCreateTrigger (SpiderEnv x) (SpiderHostFrame x) where

2239− newEventWithTrigger = SpiderHostFrame . EventM . liftIO . liftM SpiderEvent . newEventWithTriggerIO

2233+ newEventWithTrigger = SpiderHostFrame . EventM . liftIO . fmap SpiderEvent . newEventWithTriggerIO

22402234 newFanEventWithTrigger f = SpiderHostFrame $ EventM $ liftIO $ do

22412235 es <- newFanEventWithTriggerIO f

22422236 return $ R.EventSelector $ SpiderEvent . select es

test/Reflex/Bench/Focused.hs+2−3

@@ -2,7 +2,6 @@

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE FlexibleInstances #-}

44{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

65{-# LANGUAGE MultiParamTypeClasses #-}

76{-# LANGUAGE RankNTypes #-}

87{-# LANGUAGE RecursiveDo #-}

@@ -104,7 +103,7 @@ fanMerge n e = leftmost $ s <$> [0..n - 1] where

104103-- Dumb version of the above using simple fmapMaybe to filter

105104fmapFanMerge :: Reflex t => Word -> Event t Word -> Event t Word

106105fmapFanMerge n e = leftmost $ s <$> [0..n - 1] where

107− s k = flip fmapMaybe e $ \j -> if (k == j `mod` n)

106+ s k = flip fmapMaybe e $ \j -> if k == j `mod` n

108107 then Just k

109108 else Nothing

110109

@@ -181,7 +180,7 @@ switchMergeEvents mapChanges = switch . fmap mergeMap <$> holdMap mapChanges

181180-- switchMergeMaybe (UpdatedMap initial changes) = switchMergeMap initial (fmap (fromMaybe never) <$> changes)

182181

183182switchMergeBehaviors :: forall a t m k. (MonadFix m, MonadHold t m, Reflex t, Ord k) => UpdatedMap t k (Behavior t a) -> m (Behavior t (Map k a))

184−switchMergeBehaviors mapChanges = pull <$> joinMap <$> holdMap mapChanges

183+switchMergeBehaviors mapChanges = pull . joinMap <$> holdMap mapChanges

185184 where joinMap m = traverse sample =<< sample m

186185

187186-- | Turn an UpdatedMap into a Dynamic by applying the differences to the initial value

test/Reflex/Plan/Reflex.hs−2

@@ -1,12 +1,10 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE FlexibleInstances #-}

4−{-# LANGUAGE FunctionalDependencies #-}

54{-# LANGUAGE GADTs #-}

65{-# LANGUAGE GeneralizedNewtypeDeriving #-}

76{-# LANGUAGE MultiParamTypeClasses #-}

87{-# LANGUAGE RankNTypes #-}

9−{-# LANGUAGE RecursiveDo #-}

108{-# LANGUAGE ScopedTypeVariables #-}

119{-# LANGUAGE StandaloneDeriving #-}

1210{-# LANGUAGE UndecidableInstances #-}

test/Reflex/Pure.hs+6−9

@@ -23,6 +23,7 @@ import Data.Dependent.Map (DMap, GCompare)

2323import qualified Data.Dependent.Map as DMap

2424import Data.Functor.Identity

2525import Data.Functor.Misc

26+import Data.Maybe

2627import Data.MemoTrie

2728import Data.Monoid

2829import Reflex.Class

@@ -127,7 +128,7 @@ instance MonadSample (Pure t) ((->) t) where

127128

128129instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

129130

130− hold :: a -> Event (Pure t) a -> (t -> (Behavior (Pure t) a))

131+ hold :: a -> Event (Pure t) a -> t -> Behavior (Pure t) a

131132 hold initialValue e initialTime = Behavior f

132133 where f = memo $ \sampleTime ->

133134 -- Really, the sampleTime should never be prior to the initialTime,

@@ -135,16 +136,14 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

135136 if sampleTime <= initialTime

136137 then initialValue

137138 else let lastTime = pred sampleTime

138− in case unEvent e lastTime of

139− Nothing -> f lastTime

140− Just x -> x

139+ in fromMaybe (f lastTime) $ unEvent e lastTime

141140

142− holdDyn :: a -> Event (Pure t) a -> (t -> (Dynamic (Pure t) a))

141+ holdDyn :: a -> Event (Pure t) a -> t -> Dynamic (Pure t) a

143142 holdDyn initialValue e initialTime =

144143 let Behavior f = hold initialValue e initialTime

145144 in Dynamic $ \t -> (f t, unEvent e t)

146145

147− holdIncremental :: Patch p => a -> Event (Pure t) (p a) -> (t -> (Incremental (Pure t) p a))

146+ holdIncremental :: Patch p => a -> Event (Pure t) (p a) -> t -> Incremental (Pure t) p a

148147 holdIncremental initialValue e initialTime = Incremental $ \t -> (f t, unEvent e t)

149148 where f = memo $ \sampleTime ->

150149 -- Really, the sampleTime should never be prior to the initialTime,

@@ -155,6 +154,4 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

155154 lastValue = f lastTime

156155 in case unEvent e lastTime of

157156 Nothing -> lastValue

158− Just x -> case apply x lastValue of

159− Nothing -> lastValue

160− Just v' -> v'

157+ Just x -> fromMaybe lastValue $ apply x lastValue

test/Reflex/Test.hs−1

@@ -2,7 +2,6 @@

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE FlexibleInstances #-}

44{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

65{-# LANGUAGE MultiParamTypeClasses #-}

76{-# LANGUAGE RankNTypes #-}

test/Reflex/Test/CrossImpl.hs+18−22

@@ -1,21 +1,14 @@

11{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

3−{-# LANGUAGE EmptyDataDecls #-}

42{-# LANGUAGE ExistentialQuantification #-}

53{-# LANGUAGE FlexibleContexts #-}

64{-# LANGUAGE FlexibleInstances #-}

75{-# LANGUAGE FunctionalDependencies #-}

86{-# LANGUAGE GADTs #-}

9−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

107{-# LANGUAGE LambdaCase #-}

118{-# LANGUAGE MultiParamTypeClasses #-}

129{-# LANGUAGE NoMonomorphismRestriction #-}

13−{-# LANGUAGE PackageImports #-}

1410{-# LANGUAGE RankNTypes #-}

15−{-# LANGUAGE RecursiveDo #-}

1611{-# LANGUAGE ScopedTypeVariables #-}

17−{-# LANGUAGE StandaloneDeriving #-}

18−{-# LANGUAGE TemplateHaskell #-}

1912{-# LANGUAGE TypeFamilies #-}

2013{-# LANGUAGE TypeOperators #-}

2114{-# LANGUAGE UndecidableInstances #-}

@@ -93,7 +86,7 @@ testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do

9386 outputs <- forM times $ \t -> do

9487 forM_ (Map.lookup t bMap) $ \val -> mapM_ (\ rbt -> fireEvents [rbt :=> Identity val]) =<< readRef rbTrigger

9588 bOutput <- sample b'

96− eOutput <- liftM join $ forM (Map.lookup t eMap) $ \val -> do

89+ eOutput <- fmap join $ forM (Map.lookup t eMap) $ \val -> do

9790 mret <- readRef reTrigger

9891 let firing = case mret of

9992 Just ret -> [ret :=> Identity val]

@@ -131,7 +124,7 @@ testCases =

131124 b' <- hold "123" e

132125 return (b', e)

133126 , (,) "count" $ TestCase (Map.singleton 0 (), Map.fromList [(1, ()), (2, ()), (3, ())]) $ \(_, e) -> do

134− e' <- liftM updated $ count e

127+ e' <- updated <$> count e

135128 b' <- hold (0 :: Int) e'

136129 return (b', e')

137130 , (,) "onceE-1" $ TestCase (Map.singleton 0 "asdf", Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

@@ -144,23 +137,19 @@ testCases =

144137 return (b, e'')

145138 , (,) "switch-2" $ TestCase (Map.singleton 0 "asdf", Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

146139 let e' = flip pushAlways e $ const $ do

147− let ea = fmap (const "a") e

148− let eb = fmap (const "b") e

149− let eab = leftmost [ea, eb]

150− liftM switch $ hold eab never

140+ let eab = splitRecombineEvent e

141+ switch <$> hold eab never

151142 e'' = coincidence e'

152143 return (b, e'')

153144 , (,) "switch-3" $ TestCase (Map.singleton 0 "asdf", Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

154145 let e' = flip pushAlways e $ const $ do

155− let ea = fmap (const "a") e

156− let eb = fmap (const "b") e

157− let eab = leftmost [ea, eb]

158− liftM switch $ hold eab (fmap (const e) e)

146+ let eab = splitRecombineEvent e

147+ switch <$> hold eab (fmap (const e) e)

159148 e'' = coincidence e'

160149 return (b, e'')

161150 , (,) "switch-4" $ TestCase (Map.singleton 0 "asdf", Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

162151 let e' = leftmost [e, e]

163− e'' <- liftM switch $ hold e' (fmap (const e) e)

152+ e'' <- switch <$> hold e' (fmap (const e) e)

164153 return (b, e'')

165154 , (,) "switchPromptly-1" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

166155 let e' = fmap (const e) e

@@ -180,11 +169,11 @@ testCases =

180169 return (b, e'')

181170 , (,) "switch-5" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

182171 let e' = leftmost [e, e]

183− e'' <- liftM switch $ hold never (fmap (const e') e)

172+ e'' <- switch <$> hold never (fmap (const e') e)

184173 return (b, e'')

185174 , (,) "switchPromptly-5" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

186175 let e' = flip push e $ \_ -> do

187− return . Just =<< onceE e

176+ Just <$> onceE e

188177 e'' <- switchPromptly never e'

189178 return (b, e'')

190179 , (,) "switchPromptly-6" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

@@ -193,7 +182,7 @@ testCases =

193182 e'' <- switchPromptly never e'

194183 return (b, e'')

195184 , (,) "coincidence-1" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

196− let e' = flip pushAlways e $ \_ -> return $ fmap id e

185+ let e' = flip pushAlways e $ \_ -> return e

197186 e'' = coincidence e'

198187 return (b, e'')

199188 , (,) "coincidence-2" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

@@ -232,12 +221,19 @@ testCases =

232221 , (,) "joinDyn" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do

233222 bb <- hold "b" e

234223 bd <- hold never . fmap (const e) =<< onceE e

235− eOuter <- liftM (pushAlways sample . fmap (const bb)) $ onceE e

224+ eOuter <- pushAlways sample . fmap (const bb) <$> onceE e

236225 let eInner = switch bd

237226 e' = leftmost [eOuter, eInner]

238227 return (b, e')

239228 ]

240229

230+splitRecombineEvent :: Reflex t => Event t a -> Event t String

231+splitRecombineEvent e =

232+ let ea = "a" <$ e

233+ eb = "b" <$ e

234+ in leftmost [ea, eb]

235+

236+

241237test :: IO ()

242238test = do

243239 results <- forM testCases $ \(name, TestCase inputs builder) -> do

test/Reflex/Test/Micro.hs+6−7

@@ -2,7 +2,6 @@

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE FlexibleInstances #-}

44{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

65{-# LANGUAGE MultiParamTypeClasses #-}

76{-# LANGUAGE RankNTypes #-}

@@ -33,16 +32,16 @@ testCases =

3332

3433 , testB "pull-1" $ do

3534 b <- hold "0" =<< events1

36− return (id <$> id <$> b)

35+ return (pull $ sample $ pull $ sample b)

3736

3837 , testB "pull-2" $ do

3938 b1 <- behavior1

40− return (id <$> pull $ liftA2 (<>) (sample b1) (sample b1))

39+ return (pull $ liftA2 (<>) (sample b1) (sample b1))

4140

4241 , testB "pull-3" $ do

4342 b1 <- behavior1

4443 b2 <- behavior2

45− return (id <$> pull $ liftA2 (<>) (sample b1) (sample b2))

44+ return (pull $ liftA2 (<>) (sample b1) (sample b2))

4645

4746 , testB "pull-4" $ do

4847 es <- planList ["a", "b", "c"]

@@ -154,7 +153,7 @@ testCases =

154153 , testE "coincidence-1" $ do

155154 e <- events1

156155 return $ coincidence $ flip pushAlways e $

157− const $ return (id <$> e)

156+ const $ return e

158157

159158 , testE "coincidence-2" $ do

160159 e <- events1

@@ -228,7 +227,7 @@ testCases =

228227 return (mergeList es)

229228

230229 , testE "fan-3" $ do

231− f <- fanMap <$> fmap toMap <$> events3

230+ f <- fanMap . fmap toMap <$> events3

232231 return $ select f (Const2 'c')

233232

234233 , testE "fan-4" $ do

@@ -240,7 +239,7 @@ testCases =

240239 return $ toUpper <$> select (fanMap e) (Const2 'c')

241240

242241 , testE "fan-6" $ do

243− f <- fanMap <$> fmap toMap <$> events1

242+ f <- fanMap . fmap toMap <$> events1

244243 return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]

245244

246245 ] where

test/Reflex/Test/RunAll.hs−1

@@ -2,7 +2,6 @@

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE FlexibleInstances #-}

44{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

65{-# LANGUAGE MultiParamTypeClasses #-}

76{-# LANGUAGE RankNTypes #-}

test/Reflex/TestPlan.hs−4

@@ -1,14 +1,10 @@

11{-# LANGUAGE ConstraintKinds #-}

22{-# LANGUAGE FlexibleContexts #-}

33{-# LANGUAGE FlexibleInstances #-}

4−{-# LANGUAGE FunctionalDependencies #-}

54{-# LANGUAGE GADTs #-}

6−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

75{-# LANGUAGE MultiParamTypeClasses #-}

86{-# LANGUAGE RankNTypes #-}

9−{-# LANGUAGE RecursiveDo #-}

107{-# LANGUAGE ScopedTypeVariables #-}

11−{-# LANGUAGE StandaloneDeriving #-}

128{-# LANGUAGE UndecidableInstances #-}

139module Reflex.TestPlan

1410 ( TestPlan(..)

test/hlint.hsnew file+16

@@ -0,0 +1,16 @@

1+import Language.Haskell.HLint3 (hlint)

2+import System.Exit (exitFailure, exitSuccess)

4+main :: IO ()

5+main = do

6+ ideas <- hlint

7+ [ "."

8+ , "--ignore=Redundant do"

9+ , "--ignore=Use camelCase"

10+ , "--ignore=Redundant $"

11+ , "--ignore=Use &&&"

12+ , "--ignore=Use const"

13+ , "--ignore=Use >=>"

14+ , "--ignore=Use ."

15+ ]

16+ if null ideas then exitSuccess else exitFailure