ENH remove subfeature crap

bin/xmobar.hs

@@ -232,17 +232,14 @@ dateCmd = CmdSpec
 -- toJust :: a -> Bool -> Maybe a
 -- toJust x b = if b then Just x else Nothing
 
-dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency a
+dbusDep :: Bool -> BusName -> ObjectPath -> InterfaceName -> DBusMember -> Dependency
-dbusDep usesys bus obj iface mem =
+dbusDep usesys bus obj iface mem = DBusEndpoint
-  Dependency d
+  { ddDbusBus = bus
-  where
+  , ddDbusSystem = usesys
-    d = DBusEndpoint
+  , ddDbusObject = obj
-      { ddDbusBus = bus
+  , ddDbusInterface = iface
-      , ddDbusSystem = usesys
+  , ddDbusMember = mem
-      , ddDbusObject = obj
+  }
-      , ddDbusInterface = iface
-      , ddDbusMember = mem
-      }
 
 -- in the case of network interfaces, assume that the system uses systemd in
 -- which case ethernet interfaces always start with "en" and wireless
@@ -314,10 +311,10 @@ getBattery :: BarFeature
 getBattery = Feature
   { ftrAction = batteryCmd
   , ftrSilent = False
-  , ftrChildren = [Dependency $ IOTest hasBattery]
+  , ftrChildren = [IOTest hasBattery]
   }
 
-type BarFeature = Feature CmdSpec (IO ())
+type BarFeature = Feature CmdSpec
 
 getVPN :: BarFeature
 getVPN = Feature
@@ -327,7 +324,7 @@ getVPN = Feature
   }
   where
     d = dbusDep True vpnBus vpnPath vpnInterface $ Property_ vpnConnType
-    v = Dependency $ IOTest vpnPresent
+    v = IOTest vpnPresent
 
 getBt :: BarFeature
 getBt = Feature

lib/XMonad/Internal/Command/Power.hs

@@ -45,7 +45,7 @@ myOptimusManager = "optimus-manager"
 --------------------------------------------------------------------------------
 -- | Core commands
 
-runScreenLock :: Feature (X ()) (X ())
+runScreenLock :: Feature (X ())
 runScreenLock = Feature
   { ftrAction = spawn myScreenlock
   , ftrSilent = False

lib/XMonad/Internal/Concurrent/Removable.hs

@@ -33,21 +33,19 @@ memAdded = memberName_ "InterfacesAdded"
 memRemoved :: MemberName
 memRemoved = memberName_ "InterfacesRemoved"
 
-dbusDep :: MemberName -> Dependency (IO a)
+dbusDep :: MemberName -> Dependency
-dbusDep m = Dependency d
+dbusDep m = DBusEndpoint
-  where
+  { ddDbusBus = bus
-    d = DBusEndpoint
+  , ddDbusSystem = True
-      { ddDbusBus = bus
+  , ddDbusObject = path
-      , ddDbusSystem = True
+  , ddDbusInterface = interface
-      , ddDbusObject = path
+  , ddDbusMember = Signal_ m
-      , ddDbusInterface = interface
+  }
-      , ddDbusMember = Signal_ m
-      }
 
-addedDep :: Dependency (IO a)
+addedDep :: Dependency
 addedDep = dbusDep memAdded
 
-removedDep :: Dependency (IO a)
+removedDep :: Dependency
 removedDep = dbusDep memRemoved
 
 driveInsertedSound :: FilePath

lib/XMonad/Internal/DBus/Brightness/Common.hs

@@ -45,12 +45,12 @@ data BrightnessControls = BrightnessControls
   , bctlDec :: FeatureIO
   }
 
-exportBrightnessControls :: RealFrac b => [Dependency (IO ())] -> BrightnessConfig a b
+exportBrightnessControls :: RealFrac b => [Dependency] -> BrightnessConfig a b
   -> Client -> IO BrightnessControls
 exportBrightnessControls deps bc client =
   initControls client (brightnessExporter deps bc) controls
   where
-    controls exporter = let callBacklight' = callBacklight bc exporter in
+    controls _ = let callBacklight' = callBacklight bc in
       BrightnessControls
         { bctlMax = callBacklight' memMax
         , bctlMin = callBacklight' memMin
@@ -93,7 +93,7 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb = do
 --       ]
 --     }
 
-brightnessExporter :: RealFrac b => [Dependency (IO ())]
+brightnessExporter :: RealFrac b => [Dependency]
   -> BrightnessConfig a b -> Client -> FeatureIO
 brightnessExporter deps bc client = Feature
   { ftrAction = exportBrightnessControls' bc client
@@ -127,13 +127,15 @@ emitBrightness BrightnessConfig{ bcPath = p, bcInterface = i } client cur =
 -- callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
 --   void $ callMethod $ methodCall p i mem
 
-callBacklight :: BrightnessConfig a b -> FeatureIO -> MemberName -> FeatureIO
+callBacklight :: BrightnessConfig a b -> MemberName -> FeatureIO
-callBacklight BrightnessConfig { bcPath = p, bcInterface = i } exporter mem =
+callBacklight BrightnessConfig { bcPath = p, bcInterface = i } mem =
   Feature
   { ftrAction = void $ callMethod $ methodCall p i mem
   , ftrSilent = False
-  , ftrChildren = [SubFeature exporter]
+  , ftrChildren = [mkDep mem]
   }
+  where
+    mkDep = xDbusDep p i . Method_
 
 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)

lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs

@@ -82,10 +82,10 @@ intelBacklightConfig = BrightnessConfig
 --------------------------------------------------------------------------------
 -- | Exported haskell API
 
-curFileDep :: Dependency (IO a)
+curFileDep :: Dependency
 curFileDep = pathRW curFile
 
-maxFileDep :: Dependency (IO a)
+maxFileDep :: Dependency
 maxFileDep = pathR maxFile
 
 exportIntelBacklight :: Client -> IO BrightnessControls

lib/XMonad/Internal/DBus/Common.hs

@@ -6,6 +6,7 @@ module XMonad.Internal.DBus.Common
   , callMethod'
   , addMatchCallback
   , xmonadBus
+  , xDbusDep
   , initControls
   ) where
 
@@ -17,6 +18,15 @@ import           XMonad.Internal.Dependency
 xmonadBus :: BusName
 xmonadBus = busName_ "org.xmonad"
 
+xDbusDep :: ObjectPath -> InterfaceName -> DBusMember -> Dependency
+xDbusDep o i m = DBusEndpoint
+  { ddDbusBus = xmonadBus
+  , ddDbusSystem = False
+  , ddDbusObject = o
+  , ddDbusInterface = i
+  , ddDbusMember = m
+  }
+
 -- | Call a method and return its result if successful
 callMethod :: MethodCall -> IO (Maybe [Variant])
 callMethod mc = do

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -31,8 +31,8 @@ type SSState = Bool -- true is enabled
 ssExecutable :: String
 ssExecutable = "xset"
 
-ssDep :: Dependency (IO a)
+ssDep :: Dependency
-ssDep = exe ssExecutable
+ssDep = Executable ssExecutable
 
 toggle :: IO SSState
 toggle = do
@@ -102,7 +102,7 @@ newtype SSControls = SSControls { ssToggle :: FeatureIO }
 exportScreensaver :: Client -> IO SSControls
 exportScreensaver client = initControls client exportScreensaver' controls
   where
-    controls exporter = SSControls { ssToggle = callToggle exporter }
+    controls _ = SSControls { ssToggle = callToggle }
 
 exportScreensaver' :: Client -> FeatureIO
 exportScreensaver' client = Feature
@@ -119,14 +119,15 @@ exportScreensaver' client = Feature
         ]
       }
 
-callToggle :: FeatureIO -> FeatureIO
+callToggle :: FeatureIO
-callToggle exporter = Feature
+callToggle = Feature
   { ftrAction = cmd
   , ftrSilent = False
-  , ftrChildren = [SubFeature exporter]
+  , ftrChildren = mkDep <$> [memQuery, memState, memToggle]
   }
   where
     cmd = void $ callMethod $ methodCall ssPath interface memToggle
+    mkDep = xDbusDep ssPath interface . Method_
 
 callQuery :: IO (Maybe SSState)
 callQuery = do

lib/XMonad/Internal/Dependency.hs

@@ -5,7 +5,6 @@ module XMonad.Internal.Dependency
   ( MaybeExe
   , UnitType(..)
   , Dependency(..)
-  , DependencyData(..)
   , DBusMember(..)
   , MaybeX
   , FeatureX
@@ -56,7 +55,8 @@ data DBusMember = Method_ MemberName
   | Property_ String
   deriving (Eq, Show)
 
-data DependencyData = Executable String
+-- data DependencyData = Executable String
+data Dependency = Executable String
   | AccessiblePath FilePath Bool Bool
   | IOTest (IO (Maybe String))
   | DBusEndpoint
@@ -68,32 +68,27 @@ data DependencyData = Executable String
     }
   | Systemd UnitType String
 
-data Dependency a = SubFeature (Feature a a)
+-- data Dependency a = SubFeature (Feature a a)
-  | Dependency DependencyData
+--   | Dependency DependencyData
 
-data Feature a b = Feature
+data Feature a = Feature
   { ftrAction   :: a
   , ftrSilent   :: Bool
-  , ftrChildren :: [Dependency b]
+  , ftrChildren :: [Dependency]
   }
   | ConstFeature a
   | BlankFeature
 
-type FeatureX = Feature (X ()) (X ())
+type FeatureX = Feature (X ())
 
-type FeatureIO = Feature (IO ()) (IO ())
+type FeatureIO = Feature (IO ())
 
-ioFeature :: (MonadIO m, MonadIO n) => Feature (IO a) (IO b) -> Feature (m a) (n b)
+ioFeature :: (MonadIO m) => Feature (IO a) -> Feature (m a)
-ioFeature f@Feature { ftrAction = a, ftrChildren = ds } =
+ioFeature f@Feature { ftrAction = a } = f { ftrAction = liftIO a }
-  f { ftrAction = liftIO a, ftrChildren = fmap go ds }
+ioFeature (ConstFeature f)            = ConstFeature $ liftIO f
-  where
+ioFeature BlankFeature                = BlankFeature
-    go :: MonadIO o => Dependency (IO b) -> Dependency (o b)
-    go (SubFeature s) = SubFeature $ ioFeature s
-    go (Dependency d) = Dependency d
-ioFeature (ConstFeature f) = ConstFeature $ liftIO f
-ioFeature BlankFeature = BlankFeature
 
-evalFeature :: Feature a b -> IO (MaybeExe a)
+evalFeature :: Feature a -> IO (MaybeExe a)
 evalFeature (ConstFeature x) = return $ Right x
 evalFeature BlankFeature = return $ Left []
 evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
@@ -102,35 +97,28 @@ evalFeature Feature { ftrAction = a, ftrSilent = s, ftrChildren = c } = do
     []  -> Right a
     es' -> Left (if s then [] else es')
   where
-    go (SubFeature Feature { ftrChildren = cs }) = concat <$> mapM go cs
+    go = fmap maybeToList . depInstalled
-    go (Dependency d) = do
-      e <- depInstalled d
-      return $ maybeToList e
-    go (SubFeature _) = return []
 
-exe :: String -> Dependency a
+exe :: String -> Dependency
-exe = Dependency . Executable
+exe = Executable
 
-unit :: UnitType -> String -> Dependency a
+path :: Bool -> Bool -> String -> Dependency
-unit t = Dependency . Systemd t
+path r w n = AccessiblePath n r w
 
-path :: Bool -> Bool -> String -> Dependency a
+pathR :: String -> Dependency
-path r w n = Dependency $ AccessiblePath n r w
-
-pathR :: String -> Dependency a
 pathR = path True False
 
-pathW :: String -> Dependency a
+pathW :: String -> Dependency
 pathW = path False True
 
-pathRW :: String -> Dependency a
+pathRW :: String -> Dependency
 pathRW = path True True
 
-systemUnit :: String -> Dependency a
+systemUnit :: String -> Dependency
-systemUnit = unit SystemUnit
+systemUnit = Systemd SystemUnit
 
-userUnit :: String -> Dependency a
+userUnit :: String -> Dependency
-userUnit = unit UserUnit
+userUnit = Systemd UserUnit
 
 -- TODO this is poorly named. This actually represents an action that has
 -- one or more dependencies (where "action" is not necessarily executing an exe)
@@ -138,17 +126,17 @@ type MaybeExe a = Either [String] a
 
 type MaybeX = MaybeExe (X ())
 
-featureRun :: [Dependency a] -> b -> Feature b a
+featureRun :: [Dependency] -> a -> Feature a
 featureRun ds x = Feature
   { ftrAction = x
   , ftrSilent = False
   , ftrChildren = ds
   }
 
-featureSpawnCmd :: MonadIO m => String -> [String] -> Feature (m ()) (m ())
+featureSpawnCmd :: MonadIO m => String -> [String] -> Feature (m ())
 featureSpawnCmd cmd args = featureRun [exe cmd] $ spawnCmd cmd args
 
-featureSpawn :: MonadIO m => String -> Feature (m ()) (m ())
+featureSpawn :: MonadIO m => String -> Feature (m ())
 featureSpawn cmd = featureSpawnCmd cmd []
 
 exeInstalled :: String -> IO (Maybe String)
@@ -212,7 +200,7 @@ dbusInstalled bus usesystem objpath iface mem = do
     matchMem (Signal_ n) = elem n . fmap I.signalName . I.interfaceSignals
     matchMem (Property_ n) = elem n . fmap I.propertyName . I.interfaceProperties
 
-depInstalled :: DependencyData -> IO (Maybe String)
+depInstalled :: Dependency -> IO (Maybe String)
 depInstalled (Executable n)         = exeInstalled n
 depInstalled (IOTest t)             = t
 depInstalled (Systemd t n)          = unitInstalled t n