Skip to content

Commit

Permalink
Fix deprecation warnings related to updated Data.Some
Browse files Browse the repository at this point in the history
  • Loading branch information
ali-abrar committed Jun 14, 2019
1 parent def4c30 commit 1024703
Show file tree
Hide file tree
Showing 7 changed files with 35 additions and 41 deletions.
2 changes: 1 addition & 1 deletion reflex.cabal
Expand Up @@ -47,7 +47,7 @@ library
constraints-extras >= 0.2,
containers >= 0.5 && < 0.7,
data-default >= 0.5 && < 0.8,
dependent-map >= 0.2.4 && < 0.3,
dependent-map >= 0.3 && < 0.4,
exception-transformers == 0.4.*,
lens >= 4.7 && < 5,
monad-control >= 1.0.1 && < 1.1,
Expand Down
5 changes: 2 additions & 3 deletions src/Data/Functor/Misc.hs
Expand Up @@ -52,8 +52,7 @@ import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Some (Some)
import qualified Data.Some as Some
import Data.Some (Some(Some))
import Data.These
import Data.Typeable hiding (Refl)

Expand Down Expand Up @@ -121,7 +120,7 @@ intMapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=
-- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with
-- the keys, using a function to remove the wrapping 'Functor'
weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'
weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList
weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some k, f v)) . DMap.toAscList

--------------------------------------------------------------------------------
-- WrapArg
Expand Down
7 changes: 3 additions & 4 deletions src/Reflex/Class.hs
Expand Up @@ -193,8 +193,7 @@ import qualified Data.IntMap.Strict as IntMap
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
import Data.Some (Some)
import qualified Data.Some as Some
import Data.Some (Some(Some))
import Data.String
import Data.These
import Data.Type.Coercion
Expand Down Expand Up @@ -1155,9 +1154,9 @@ factorEvent
-> Event t (DSum k v)
-> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
factorEvent k0 kv' = do
key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
Some.This oldKey -> case newKey `geq` oldKey of
Some oldKey -> case newKey `geq` oldKey of
Just Refl -> return Nothing
Nothing -> do
newInner <- filterEventKey newKey kv'
Expand Down
7 changes: 3 additions & 4 deletions src/Reflex/Patch/DMapWithMove.hs
Expand Up @@ -30,8 +30,7 @@ import Data.GADT.Show (GShow, gshow)
import qualified Data.Map as Map
import Data.Maybe
import Data.Semigroup (Semigroup (..), (<>))
import Data.Some (Some)
import qualified Data.Some as Some
import Data.Some (Some(Some))
import Data.These

-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and
Expand Down Expand Up @@ -311,8 +310,8 @@ weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenD
{ MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
From_Insert v -> MapWithMove.From_Insert $ f v
From_Delete -> MapWithMove.From_Delete
From_Move k -> MapWithMove.From_Move $ Some.This k
, MapWithMove._nodeInfo_to = Some.This <$> getComposeMaybe (_nodeInfo_to ni)
From_Move k -> MapWithMove.From_Move $ Some k
, MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
}

-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any
Expand Down
11 changes: 5 additions & 6 deletions src/Reflex/Query/Base.hs
Expand Up @@ -38,8 +38,7 @@ import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import qualified Data.Semigroup as S
import Data.Some (Some)
import qualified Data.Some as Some
import Data.Some (Some(Some))
import Data.These

import Reflex.Class
Expand Down Expand Up @@ -145,10 +144,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t
liftedResult' = fforCheap result' $ \(PatchDMap p) -> PatchDMap $
mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mr) -> k :=> ComposeMaybe (fmap (getQueryTLoweredResultValue . getCompose) mr)) p
liftedBs0 :: Map (Some k) [Behavior t q]
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])
liftedBs' = fforCheap result' $ \(PatchDMap p) -> PatchMap $
Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some.This k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p
Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p
sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty
accumBehaviors :: forall m'. MonadHold t m'
Expand Down Expand Up @@ -189,10 +188,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t
let liftedResult0 = mapKeyValuePairsMonotonic (\(k :=> Compose r) -> k :=> getQueryTLoweredResultValue r) result0
liftedResult' = fforCheap result' $ mapPatchDMapWithMove (getQueryTLoweredResultValue . getCompose)
liftedBs0 :: Map (Some k) [Behavior t q]
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])
liftedBs' = fforCheap result' $ weakenPatchDMapWithMoveWith (getQueryTLoweredResultWritten . getCompose) {- \(PatchDMap p) -> PatchMapWithMove $
Map.fromDistinctAscList $ (\(k :=> mr) -> (Some.This k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
Map.fromDistinctAscList $ (\(k :=> mr) -> (Some k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty
accumBehaviors' :: forall m'. MonadHold t m'
Expand Down
5 changes: 2 additions & 3 deletions src/Reflex/Requester/Base.hs
Expand Up @@ -66,8 +66,7 @@ import qualified Data.Map as Map
import Data.Monoid ((<>))
import Data.Proxy
import qualified Data.Semigroup as S
import Data.Some (Some)
import qualified Data.Some as Some
import Data.Some (Some(Some))
import Data.Type.Equality
import Data.Unique.Tag

Expand Down Expand Up @@ -441,7 +440,7 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN
pack = Entry
f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
f' k (Compose (n, v)) = do
(result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))
(result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))
return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
ndm' <- numberOccurrencesFrom 1 dm'
(children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
Expand Down
39 changes: 19 additions & 20 deletions src/Reflex/Spider/Internal.hs
Expand Up @@ -74,8 +74,7 @@ import Data.Tree (Forest, Tree (..), drawForest)
import Data.FastWeakBag (FastWeakBag)
import qualified Data.FastWeakBag as FastWeakBag
import Data.Reflection
import Data.Some (Some)
import qualified Data.Some as Some
import Data.Some (Some(Some))
import Data.Type.Coercion
import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)
import qualified Data.WeakBag as WeakBag
Expand Down Expand Up @@ -582,7 +581,7 @@ eventSubscribedFan !subscribed = EventSubscribed
{ eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed
, eventSubscribedRetained = toAny subscribed
#ifdef DEBUG_CYCLES
, eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
, eventSubscribedGetParents = return [Some $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]
, eventSubscribedHasOwnHeightRef = False
, eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed
#endif
Expand All @@ -595,7 +594,7 @@ eventSubscribedSwitch !subscribed = EventSubscribed
#ifdef DEBUG_CYCLES
, eventSubscribedGetParents = do
s <- readIORef $ switchSubscribedCurrentParent subscribed
return [Some.This $ _eventSubscription_subscribed s]
return [Some $ _eventSubscription_subscribed s]
, eventSubscribedHasOwnHeightRef = True
, eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed
#endif
Expand All @@ -608,8 +607,8 @@ eventSubscribedCoincidence !subscribed = EventSubscribed
#ifdef DEBUG_CYCLES
, eventSubscribedGetParents = do
innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed
let outerParent = Some.This $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
innerParents = maybeToList $ fmap Some.This innerSubscription
let outerParent = Some $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed
innerParents = maybeToList $ fmap Some innerSubscription
return $ outerParent : innerParents
, eventSubscribedHasOwnHeightRef = True
, eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed
Expand All @@ -625,13 +624,13 @@ whoCreatedEventSubscribed = eventSubscribedWhoCreated

walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]
walkInvalidHeightParents s0 = do
subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do
subscribers <- flip execStateT mempty $ ($ Some s0) $ fix $ \loop (Some s) -> do
h <- liftIO $ readIORef $ eventSubscribedHeightRef s
when (h == invalidHeight) $ do
when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed
modify (Some.This s :)
modify (Some s :)
mapM_ loop =<< liftIO (eventSubscribedGetParents s)
forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
forM_ subscribers $ \(Some s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight
return subscribers
#endif

Expand Down Expand Up @@ -659,7 +658,7 @@ behaviorPull !p = Behavior $ do
val <- liftIO $ readIORef $ pullValue p
case val of
Just subscribed -> do
askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedPull subscribed)) :))
askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))
askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))
liftIO $ touch $ pullSubscribedOwnInvalidator subscribed
return $ pullSubscribedValue subscribed
Expand All @@ -678,7 +677,7 @@ behaviorPull !p = Behavior $ do
, pullSubscribedParents = parents
}
liftIO $ writeIORef (pullValue p) $ Just subscribed
askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedPull subscribed)) :))
askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))
return a

behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)
Expand All @@ -689,7 +688,7 @@ readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)
readHoldTracked h = do
result <- liftIO $ readIORef $ holdValue h
askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))
askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some.This (BehaviorSubscribedHold h)) :))
askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedHold h)) :))
liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected
return result

Expand Down Expand Up @@ -862,23 +861,23 @@ instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where

{-# INLINE scheduleClear #-}
scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()
scheduleClear r = defer $ Some.This $ Clear r
scheduleClear r = defer $ Some $ Clear r

instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where
{-# INLINE getDeferralQueue #-}
getDeferralQueue = asksEventEnv eventEnvIntClears

{-# INLINE scheduleIntClear #-}
scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()
scheduleIntClear r = defer $ Some.This $ IntClear r
scheduleIntClear r = defer $ Some $ IntClear r

instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where
{-# INLINE getDeferralQueue #-}
getDeferralQueue = asksEventEnv eventEnvRootClears

{-# INLINE scheduleRootClear #-}
scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()
scheduleRootClear r = defer $ Some.This $ RootClear r
scheduleRootClear r = defer $ Some $ RootClear r

instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where
{-# INLINE getDeferralQueue #-}
Expand Down Expand Up @@ -1853,7 +1852,7 @@ mergeSubscriber m getKey = Subscriber
else liftIO $ do
#ifdef DEBUG_CYCLES
nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed
stacks <- forM nodesInvolvedInCycle $ \(Some.This es) -> whoCreatedEventSubscribed es
stacks <- forM nodesInvolvedInCycle $ \(Some es) -> whoCreatedEventSubscribed es
let cycleInfo = ":\n" <> drawForest (listsToForest stacks)
#else
let cycleInfo = ""
Expand Down Expand Up @@ -2096,11 +2095,11 @@ runFrame a = SpiderHost $ do
return result
result <- runEventM go
toClear <- readIORef $ eventEnvClears env
forM_ toClear $ \(Some.This (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing
forM_ toClear $ \(Some (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing
toClearInt <- readIORef $ eventEnvIntClears env
forM_ toClearInt $ \(Some.This (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty
forM_ toClearInt $ \(Some (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty
toClearRoot <- readIORef $ eventEnvRootClears env
forM_ toClearRoot $ \(Some.This (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
forM_ toClearRoot $ \(Some (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty
toAssign <- readIORef $ eventEnvAssignments env
toReconnectRef <- newIORef []
coincidenceInfos <- readIORef $ eventEnvResetCoincidences env
Expand Down Expand Up @@ -2460,7 +2459,7 @@ unsafeNewSpiderTimelineEnv = do

-- | Create a new SpiderTimelineEnv
newSpiderTimeline :: IO (Some SpiderTimelineEnv)
newSpiderTimeline = withSpiderTimeline (pure . Some.This)
newSpiderTimeline = withSpiderTimeline (pure . Some)

data LocalSpiderTimeline x s

Expand Down

0 comments on commit 1024703

Please sign in to comment.