REF (kinda) remove dep lift functions

This commit is contained in:
Nathan Dwarshuis 2022-12-31 16:23:17 -05:00
parent e76050a7a1
commit 044b4cddc0
1 changed files with 19 additions and 19 deletions

View File

@ -69,8 +69,8 @@ module Data.Internal.Dependency
, readWireless , readWireless
, socketExists , socketExists
-- lifting -- lifting
, ioSometimes -- , ioSometimes
, ioAlways -- , ioAlways
-- feature construction -- feature construction
, always1 , always1
, sometimes1 , sometimes1
@ -905,28 +905,28 @@ testDBusDepNoCache_ _ (DBusIO i) = testIODepNoCache_ i
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- IO Lifting functions -- IO Lifting functions
ioSometimes :: MonadIO m => Sometimes (IO a) -> Sometimes (m a) -- ioSometimes :: MonadIO m => Sometimes (IO a) -> Sometimes (m a)
ioSometimes (Sometimes n t xs) = Sometimes n t $ fmap ioSubfeature xs -- ioSometimes (Sometimes n t xs) = Sometimes n t $ fmap ioSubfeature xs
ioAlways :: MonadIO m => Always (IO a) -> Always (m a) -- ioAlways :: MonadIO m => Always (IO a) -> Always (m a)
ioAlways (Always n x) = Always n $ ioAlways' x -- ioAlways (Always n x) = Always n $ ioAlways' x
ioAlways' :: MonadIO m => Always_ (IO a) -> Always_ (m a) -- ioAlways' :: MonadIO m => Always_ (IO a) -> Always_ (m a)
ioAlways' (Always_ ar) = Always_ $ ioFallbackRoot ar -- ioAlways' (Always_ ar) = Always_ $ ioFallbackRoot ar
ioAlways' (Option sf a) = Option (ioSubfeature sf) $ ioAlways' a -- ioAlways' (Option sf a) = Option (ioSubfeature sf) $ ioAlways' a
ioFallbackRoot :: MonadIO m => FallbackRoot (IO a) -> FallbackRoot (m a) -- ioFallbackRoot :: MonadIO m => FallbackRoot (IO a) -> FallbackRoot (m a)
ioFallbackRoot (FallbackAlone a) = FallbackAlone $ io a -- ioFallbackRoot (FallbackAlone a) = FallbackAlone $ io a
ioFallbackRoot (FallbackTree a s) = FallbackTree (io . a) s -- ioFallbackRoot (FallbackTree a s) = FallbackTree (io . a) s
ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a) -- ioSubfeature :: MonadIO m => SubfeatureRoot (IO a) -> SubfeatureRoot (m a)
ioSubfeature sf = sf {sfData = ioRoot $ sfData sf} -- ioSubfeature sf = sf {sfData = ioRoot $ sfData sf}
ioRoot :: MonadIO m => Root (IO a) -> Root (m a) -- ioRoot :: MonadIO m => Root (IO a) -> Root (m a)
ioRoot (IORoot a t) = IORoot (io . a) t -- ioRoot (IORoot a t) = IORoot (io . a) t
ioRoot (IORoot_ a t) = IORoot_ (io a) t -- ioRoot (IORoot_ a t) = IORoot_ (io a) t
ioRoot (DBusRoot a t cl) = DBusRoot (\p c -> io $ a p c) t cl -- ioRoot (DBusRoot a t cl) = DBusRoot (\p c -> io $ a p c) t cl
ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl -- ioRoot (DBusRoot_ a t cl) = DBusRoot_ (io . a) t cl
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Feature constructors -- Feature constructors