From d00f0408f9cdb49a21f7cc72d7fba96fea3033f2 Mon Sep 17 00:00:00 2001 From: John Ericson Date: Fri, 10 Jun 2022 11:56:32 -0400 Subject: [PATCH] Fix some warnings --- src/Control/Monad/ReaderIO.hs | 2 -- src/Data/AppendMap.hs | 4 +++- src/Reflex/Class.hs | 19 +++++++++-------- src/Reflex/Dynamic.hs | 3 --- src/Reflex/Dynamic/TH.hs | 1 - src/Reflex/Dynamic/Uniq.hs | 3 --- src/Reflex/DynamicWriter/Base.hs | 1 - src/Reflex/EventWriter/Class.hs | 1 - src/Reflex/FunctorMaybe.hs | 4 ++++ src/Reflex/PostBuild/Base.hs | 1 - src/Reflex/Profiled.hs | 1 - src/Reflex/Query/Base.hs | 1 - src/Reflex/Query/Class.hs | 1 - src/Reflex/Requester/Base.hs | 7 ++----- src/Reflex/Spider/Internal.hs | 35 +++++++++++++------------------- src/Reflex/Time.hs | 1 - src/Reflex/TriggerEvent/Base.hs | 1 - 17 files changed, 33 insertions(+), 53 deletions(-) diff --git a/src/Control/Monad/ReaderIO.hs b/src/Control/Monad/ReaderIO.hs index ad235fe7..98411e96 100644 --- a/src/Control/Monad/ReaderIO.hs +++ b/src/Control/Monad/ReaderIO.hs @@ -38,8 +38,6 @@ instance Applicative (ReaderIO e) where liftA2 = liftM2 {-# INLINE liftA2 #-} #endif - (*>) = (>>) - {-# INLINE (*>) #-} instance Monad (ReaderIO e) where ReaderIO q >>= f = ReaderIO $ \e -> q e >>= \a -> runReaderIO (f a) e diff --git a/src/Data/AppendMap.hs b/src/Data/AppendMap.hs index 4bfd8e0c..360e042a 100644 --- a/src/Data/AppendMap.hs +++ b/src/Data/AppendMap.hs @@ -30,9 +30,11 @@ import qualified Data.Map.Internal.Debug as Map (showTree, showTreeWith) #else import qualified Data.Map as Map (showTree, showTreeWith) #endif +#if !MIN_VERSION_witherable(0,3,2) import qualified Data.Witherable as W -import Data.Map.Monoidal import qualified Data.Map.Monoidal as MonoidalMap +#endif +import Data.Map.Monoidal {-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-} diff --git a/src/Reflex/Class.hs b/src/Reflex/Class.hs index fbdbfce5..f05b18e3 100644 --- a/src/Reflex/Class.hs +++ b/src/Reflex/Class.hs @@ -202,7 +202,6 @@ import qualified Data.Dependent.Map as DMap import Data.Functor.Compose import Data.Functor.Product import Data.GADT.Compare (GEq (..), GCompare (..)) -import Data.FastMutableIntMap (PatchIntMap) import Data.Foldable import Data.Functor.Bind import Data.Functor.Misc @@ -218,8 +217,13 @@ import Data.String import Data.These import Data.Type.Coercion import Data.Type.Equality ((:~:) (..)) +#if MIN_VERSION_witherable(0,4,0) +import Witherable (Filterable(..)) +import qualified Witherable as W +#else import Data.Witherable (Filterable(..)) import qualified Data.Witherable as W +#endif import Reflex.FunctorMaybe (FunctorMaybe) import qualified Reflex.FunctorMaybe import Data.Patch @@ -678,14 +682,17 @@ instance (Reflex t, IsString a) => IsString (Behavior t a) where instance Reflex t => Monad (Behavior t) where a >>= f = pull $ sample a >>= sample . f -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail. Since we can't examine 'Behavior's other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above. - return = constant #if !MIN_VERSION_base(4,13,0) fail = error "Monad (Behavior t) does not support fail" #endif +instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where + a <> b = pull $ liftM2 (<>) (sample a) (sample b) + sconcat = pull . fmap sconcat . mapM sample + stimes n = fmap $ stimes n + instance (Reflex t, Monoid a) => Monoid (Behavior t a) where mempty = constant mempty - mappend a b = pull $ liftM2 mappend (sample a) (sample b) mconcat = pull . fmap mconcat . mapM sample instance (Reflex t, Num a) => Num (Behavior t a) where @@ -706,11 +713,6 @@ instance (Num a, Reflex t) => Num (Dynamic t a) where negate = fmap negate (-) = liftA2 (-) -instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where - a <> b = pull $ liftM2 (<>) (sample a) (sample b) - sconcat = pull . fmap sconcat . mapM sample - stimes n = fmap $ stimes n - -- | Alias for 'mapMaybe' fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b fmapMaybe = mapMaybe @@ -1157,7 +1159,6 @@ instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where mconcat = distributeListOverDynWith mconcat mempty = constDyn mempty - mappend = zipDynWith mappend -- | This function converts a 'DMap' whose elements are 'Dynamic's into a -- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same diff --git a/src/Reflex/Dynamic.hs b/src/Reflex/Dynamic.hs index 649c7a87..d4fdba0a 100644 --- a/src/Reflex/Dynamic.hs +++ b/src/Reflex/Dynamic.hs @@ -82,7 +82,6 @@ import Data.Functor.Compose import Data.Functor.Misc import Reflex.Class -import Control.Monad import Control.Monad.Fix import Control.Monad.Identity import Data.Align @@ -91,11 +90,9 @@ import qualified Data.Dependent.Map as DMap import Data.Dependent.Sum (DSum (..)) import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..)) import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap import Data.Kind (Type) import Data.Map (Map) import Data.Maybe -import Data.Monoid ((<>)) import Data.These import Data.Type.Equality ((:~:) (..)) diff --git a/src/Reflex/Dynamic/TH.hs b/src/Reflex/Dynamic/TH.hs index b7759bef..61dd4189 100644 --- a/src/Reflex/Dynamic/TH.hs +++ b/src/Reflex/Dynamic/TH.hs @@ -20,7 +20,6 @@ import Reflex.Dynamic import Control.Monad.State import Data.Data import Data.Generics -import Data.Monoid ((<>)) import qualified Language.Haskell.Exts as Hs import qualified Language.Haskell.Meta.Syntax.Translate as Hs import Language.Haskell.TH diff --git a/src/Reflex/Dynamic/Uniq.hs b/src/Reflex/Dynamic/Uniq.hs index e118af9d..66347dec 100644 --- a/src/Reflex/Dynamic/Uniq.hs +++ b/src/Reflex/Dynamic/Uniq.hs @@ -14,7 +14,6 @@ module Reflex.Dynamic.Uniq , alreadyUniqDynamic ) where -import Control.Applicative (Applicative (..)) import GHC.Exts import Reflex.Class @@ -101,5 +100,3 @@ instance Reflex t => Applicative (UniqDynamic t) where instance Reflex t => Monad (UniqDynamic t) where UniqDynamic x >>= f = uniqDynamic $ x >>= unUniqDynamic . f - _ >> b = b - return = pure diff --git a/src/Reflex/DynamicWriter/Base.hs b/src/Reflex/DynamicWriter/Base.hs index af7d1359..579784a2 100644 --- a/src/Reflex/DynamicWriter/Base.hs +++ b/src/Reflex/DynamicWriter/Base.hs @@ -36,7 +36,6 @@ import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.Map (Map) import qualified Data.Map as Map -import Data.Semigroup (Semigroup(..)) import Data.Some (Some) import Data.These diff --git a/src/Reflex/EventWriter/Class.hs b/src/Reflex/EventWriter/Class.hs index 41aadd35..174aa55d 100644 --- a/src/Reflex/EventWriter/Class.hs +++ b/src/Reflex/EventWriter/Class.hs @@ -11,7 +11,6 @@ module Reflex.EventWriter.Class ) where import Control.Monad.Reader (ReaderT, lift) -import Data.Semigroup (Semigroup) import Reflex.Class (Event) diff --git a/src/Reflex/FunctorMaybe.hs b/src/Reflex/FunctorMaybe.hs index 84656db5..d4c62976 100644 --- a/src/Reflex/FunctorMaybe.hs +++ b/src/Reflex/FunctorMaybe.hs @@ -19,7 +19,11 @@ import Data.Map (Map) #if !MIN_VERSION_base(4,16,0) import Data.Semigroup (Option(..)) #endif +#if MIN_VERSION_witherable(0,4,0) +import Witherable +#else import Data.Witherable +#endif --TODO: See if there's a better class in the standard libraries already diff --git a/src/Reflex/PostBuild/Base.hs b/src/Reflex/PostBuild/Base.hs index 5dba681b..9eed200d 100644 --- a/src/Reflex/PostBuild/Base.hs +++ b/src/Reflex/PostBuild/Base.hs @@ -55,7 +55,6 @@ runPostBuildT (PostBuildT a) = runReaderT a -- TODO: Monoid and Semigroup can likely be derived once ReaderT has them. instance (Monoid a, Applicative m) => Monoid (PostBuildT t m a) where mempty = pure mempty - mappend = liftA2 mappend instance (S.Semigroup a, Applicative m) => S.Semigroup (PostBuildT t m a) where (<>) = liftA2 (S.<>) diff --git a/src/Reflex/Profiled.hs b/src/Reflex/Profiled.hs index f579df1b..6d1fe02a 100644 --- a/src/Reflex/Profiled.hs +++ b/src/Reflex/Profiled.hs @@ -36,7 +36,6 @@ import Data.List import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map.Strict as Map -import Data.Monoid ((<>)) import Data.Ord import Data.Profunctor.Unsafe ((#.)) import qualified Data.Semigroup as S diff --git a/src/Reflex/Query/Base.hs b/src/Reflex/Query/Base.hs index ef09e051..b3b5cc8f 100644 --- a/src/Reflex/Query/Base.hs +++ b/src/Reflex/Query/Base.hs @@ -40,7 +40,6 @@ import qualified Data.IntMap as IntMap import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map -import Data.Monoid ((<>)) import qualified Data.Semigroup as S import Data.Some (Some(Some)) import Data.These diff --git a/src/Reflex/Query/Class.hs b/src/Reflex/Query/Class.hs index 0e333ced..e5f823d8 100644 --- a/src/Reflex/Query/Class.hs +++ b/src/Reflex/Query/Class.hs @@ -37,7 +37,6 @@ import Data.Ix import Data.Kind (Type) import Data.Map.Monoidal (MonoidalMap) import qualified Data.Map.Monoidal as MonoidalMap -import Data.Semigroup (Semigroup(..)) import Data.Void import Data.Monoid hiding ((<>)) import Foreign.Storable diff --git a/src/Reflex/Requester/Base.hs b/src/Reflex/Requester/Base.hs index ab65f1ce..7d3d69e9 100644 --- a/src/Reflex/Requester/Base.hs +++ b/src/Reflex/Requester/Base.hs @@ -69,9 +69,7 @@ import qualified Data.IntMap.Strict as IntMap import Data.Kind (Type) import Data.Map (Map) import qualified Data.Map as Map -import Data.Monoid ((<>)) import Data.Proxy -import qualified Data.Semigroup as S import Data.Some (Some(Some)) import Data.Type.Equality import Data.Unique.Tag @@ -306,10 +304,9 @@ instance PrimMonad m => PrimMonad (RequesterT t request response m) where -- TODO: Monoid and Semigroup can likely be derived once StateT has them. instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where mempty = pure mempty - mappend = liftA2 mappend -instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where - (<>) = liftA2 (S.<>) +instance (Semigroup a, Monad m) => Semigroup (RequesterT t request response m a) where + (<>) = liftA2 (<>) -- | Run a 'RequesterT' action. The resulting 'Event' will fire whenever diff --git a/src/Reflex/Spider/Internal.hs b/src/Reflex/Spider/Internal.hs index ff4b4835..990d141a 100644 --- a/src/Reflex/Spider/Internal.hs +++ b/src/Reflex/Spider/Internal.hs @@ -42,14 +42,16 @@ import Control.Monad.Reader.Class import Control.Monad.IO.Class import Control.Monad.ReaderIO import Control.Monad.Ref +#if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail (MonadFail) +#endif import qualified Control.Monad.Fail as MonadFail import Data.Align import Data.Coerce import Data.Dependent.Map (DMap) import qualified Data.Dependent.Map as DMap import Data.Dependent.Sum (DSum (..)) -import Data.FastMutableIntMap (FastMutableIntMap, PatchIntMap (..)) +import Data.FastMutableIntMap (FastMutableIntMap) import qualified Data.FastMutableIntMap as FastMutableIntMap import Data.Foldable hiding (concat, elem, sequence_) import Data.Functor.Constant @@ -61,12 +63,15 @@ import qualified Data.IntMap.Strict as IntMap import Data.IORef import Data.Kind (Type) import Data.Maybe hiding (mapMaybe) -import Data.Monoid (mempty, (<>)) import Data.Proxy import Data.These import Data.Traversable import Data.Type.Equality ((:~:)(Refl)) +#if MIN_VERSION_witherable(0,4,0) +import Witherable (Filterable, mapMaybe) +#else import Data.Witherable (Filterable, mapMaybe) +#endif import GHC.Exts hiding (toList) import GHC.IORef (IORef (..)) import GHC.Stack @@ -91,7 +96,10 @@ import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence) import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Tree (Forest, Tree (..), drawForest) + +#ifdef DEBUG_HIDE_INTERNALS import Data.List (isPrefixOf) +#endif import Data.FastWeakBag (FastWeakBag, FastWeakBagTicket) import qualified Data.FastWeakBag as FastWeakBag @@ -990,10 +998,6 @@ newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderIO (BehaviorEnv x) a } instance Monad (BehaviorM x) where {-# INLINE (>>=) #-} BehaviorM x >>= f = BehaviorM $ x >>= unBehaviorM . f - {-# INLINE (>>) #-} - BehaviorM x >> BehaviorM y = BehaviorM $ x >> y - {-# INLINE return #-} - return x = BehaviorM $ return x #if !MIN_VERSION_base(4,13,0) {-# INLINE fail #-} fail s = BehaviorM $ fail s @@ -1093,7 +1097,7 @@ heightBagRemove (Height h) b@(HeightBag s c) = heightBagVerify $ case IntMap.loo _ -> IntMap.insert h (pred old) c heightBagRemoveMaybe :: Height -> HeightBag -> Maybe HeightBag -heightBagRemoveMaybe (Height h) b@(HeightBag s c) = heightBagVerify . removed <$> IntMap.lookup h c where +heightBagRemoveMaybe (Height h) (HeightBag s c) = heightBagVerify . removed <$> IntMap.lookup h c where removed old = HeightBag (pred s) $ case old of 0 -> IntMap.delete h c _ -> IntMap.insert h (pred old) c @@ -1470,7 +1474,7 @@ filterStack :: String -> [String] -> [String] #ifdef DEBUG_HIDE_INTERNALS filterStack prefix = filter (not . (prefix `isPrefixOf`)) #else -filterStack prefix = id +filterStack _prefix = id #endif #ifdef DEBUG_CYCLES @@ -2548,12 +2552,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where - {-# INLINE return #-} - return = pure {-# INLINE (>>=) #-} x >>= f = SpiderDynamic $ dynamicDynIdentity $ newJoinDyn $ newMapDyn (unSpiderDynamic . f) $ unSpiderDynamic x - {-# INLINE (>>) #-} - (>>) = (*>) #if !MIN_VERSION_base(4,13,0) {-# INLINE fail #-} fail _ = error "Dynamic does not support 'fail'" @@ -2834,15 +2834,12 @@ instance MonadAtomicRef (EventM x) where atomicModifyRef r f = liftIO $ atomicModifyRef r f -- | The monad for actions that manipulate a Spider timeline identified by @x@ -newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException) +newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a } + deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException) instance Monad (SpiderHost x) where {-# INLINABLE (>>=) #-} SpiderHost x >>= f = SpiderHost $ x >>= unSpiderHost . f - {-# INLINABLE (>>) #-} - SpiderHost x >> SpiderHost y = SpiderHost $ x >> y - {-# INLINABLE return #-} - return x = SpiderHost $ return x #if !MIN_VERSION_base(4,13,0) {-# INLINABLE fail #-} fail = MonadFail.fail @@ -2868,10 +2865,6 @@ newtype SpiderHostFrame (x :: Type) a = SpiderHostFrame { runSpiderHostFrame :: instance Monad (SpiderHostFrame x) where {-# INLINABLE (>>=) #-} SpiderHostFrame x >>= f = SpiderHostFrame $ x >>= runSpiderHostFrame . f - {-# INLINABLE (>>) #-} - SpiderHostFrame x >> SpiderHostFrame y = SpiderHostFrame $ x >> y - {-# INLINABLE return #-} - return x = SpiderHostFrame $ return x #if !MIN_VERSION_base(4,13,0) {-# INLINABLE fail #-} fail s = SpiderHostFrame $ fail s diff --git a/src/Reflex/Time.hs b/src/Reflex/Time.hs index 4ae42f26..61837309 100644 --- a/src/Reflex/Time.hs +++ b/src/Reflex/Time.hs @@ -33,7 +33,6 @@ import Control.Monad.IO.Class import Data.Align import Data.Data (Data) import Data.Fixed -import Data.Semigroup (Semigroup(..)) import Data.Sequence (Seq, (|>)) import qualified Data.Sequence as Seq import Data.These diff --git a/src/Reflex/TriggerEvent/Base.hs b/src/Reflex/TriggerEvent/Base.hs index eb0edfd7..ef240993 100644 --- a/src/Reflex/TriggerEvent/Base.hs +++ b/src/Reflex/TriggerEvent/Base.hs @@ -22,7 +22,6 @@ import Control.Monad.Ref import Data.Coerce import Data.Dependent.Sum import Data.IORef -import Data.Monoid ((<>)) import qualified Data.Semigroup as S import Reflex.Class import Reflex.Adjustable.Class