ENH use a bunch of nested feature stuff

bin/xmobar.hs

@@ -292,46 +292,47 @@ rightPlugins sysClient sesClient = mapM evalFeature
 
 getWireless :: BarFeature
 getWireless = feature "wireless status indicator" Default
-  $ GenTree (Double wirelessCmd $ readInterface isWireless) []
+  -- TODO this is stupid
+  $ GenTree (Double wirelessCmd $ readInterface isWireless) (Only $ exe "ls")
 
 getEthernet :: Maybe Client -> BarFeature
 getEthernet client = feature "ethernet status indicator" Default
-  $ DBusTree action client [devDep] []
+  $ DBusTree action client (Only $ fullDep devDep)
   where
     action = Double (\i _ -> ethernetCmd i) (readInterface isEthernet)
 
 getBattery :: BarFeature
 getBattery = feature "battery level indicator" Default
-  $ GenTree (Single batteryCmd) [IOTest desc hasBattery]
+  $ GenTree (Single batteryCmd) (Only $ fullDep $ IOTest desc hasBattery)
   where
     desc = "Test if battery is present"
 
 getVPN :: Maybe Client -> BarFeature
 getVPN client = feature "VPN status indicator" Default
-  $ DBusTree (Single (const vpnCmd)) client [vpnDep] [dp]
+  $ DBusTree (Single (const vpnCmd)) client $ And (Only $ fullDep vpnDep) (Only dp)
   where
-    dp = IOTest desc vpnPresent
+    dp = fullDep $ DBusGenDep $ IOTest desc vpnPresent
     desc = "Use nmcli to test if VPN is present"
 
 getBt :: Maybe Client -> BarFeature
 getBt client = feature "bluetooth status indicator" Default
-  $ DBusTree (Single (const btCmd)) client [btDep] []
+  $ DBusTree (Single (const btCmd)) client (Only $ fullDep btDep)
 
 getAlsa :: BarFeature
 getAlsa = feature "volume level indicator" Default
-  $ GenTree (Single alsaCmd) [Executable "alsactl"]
+  $ GenTree (Single alsaCmd) (Only $ exe "alsactl")
 
 getBl :: Maybe Client -> BarFeature
 getBl client = feature "Intel backlight indicator" Default
-  $ DBusTree (Single (const blCmd)) client [intelBacklightSignalDep] []
+  $ DBusTree (Single (const blCmd)) client (Only $ fullDep intelBacklightSignalDep)
 
 getCk :: Maybe Client -> BarFeature
 getCk client = feature "Clevo keyboard indicator" Default
-  $ DBusTree (Single (const ckCmd)) client [clevoKeyboardSignalDep] []
+  $ DBusTree (Single (const ckCmd)) client (Only $ fullDep clevoKeyboardSignalDep)
 
 getSs :: Maybe Client -> BarFeature
 getSs client = feature "screensaver indicator" Default
-  $ DBusTree (Single (const ssCmd)) client [ssSignalDep] []
+  $ DBusTree (Single (const ssCmd)) client (Only $ fullDep ssSignalDep)
 
 getAllCommands :: [MaybeAction CmdSpec] -> IO BarRegions
 getAllCommands right = do

bin/xmonad.hs

@@ -122,32 +122,32 @@ run = do
     forkIO_ = void . forkIO
 
 printDeps :: IO ()
-printDeps = do
+printDeps = skip
-  (i, x) <- allFeatures
+  -- (i, x) <- allFeatures
-  mapM_ printDep $ concatMap extractFeatures i ++ concatMap extractFeatures x
+  -- mapM_ printDep $ concatMap extractFeatures i ++ concatMap extractFeatures x
-  where
+  -- where
-    extractFeatures (Feature f)      = dtDeps $ ftrDepTree f
+  --   extractFeatures (Feature f _)    = dtDeps $ ftrDepTree f
-    extractFeatures (ConstFeature _) = []
+  --   extractFeatures (ConstFeature _) = []
-    dtDeps (GenTree _ ds)      = ds
+  --   dtDeps (GenTree _ ds)    = ds
-    dtDeps (DBusTree _ _ _ ds) = ds
+  --   dtDeps (DBusTree _ _ ds) = ds
-    printDep = putStrLn . depName
+  --   printDep (FullDep d) = putStrLn . depName d
 
-allFeatures :: IO ([FeatureIO], [FeatureX])
+-- allFeatures :: IO ([FeatureIO], [FeatureX])
-allFeatures = do
+-- allFeatures = do
-  ses <- getDBusClient False
+--   ses <- getDBusClient False
-  sys <- getDBusClient True
+--   sys <- getDBusClient True
-  let db = DBusState ses sys
+--   let db = DBusState ses sys
-  lockRes <- evalFeature runScreenLock
+--   lockRes <- evalFeature runScreenLock
-  let lock = whenSatisfied lockRes
+--   let lock = whenSatisfied lockRes
-  let bfs = concatMap (fmap kbMaybeAction . kgBindings)
+--   let bfs = concatMap (fmap kbMaybeAction . kgBindings)
-            $ externalBindings ts db lock
+--             $ externalBindings ts db lock
-  let dbus = fmap (\f -> f ses) dbusExporters
+--   let dbus = fmap (\f -> f ses) dbusExporters
-  let others =  [runRemovableMon sys, runPowermon]
+--   let others =  [runRemovableMon sys, runPowermon]
-  forM_ ses disconnect
+--   forM_ ses disconnect
-  forM_ sys disconnect
+--   forM_ sys disconnect
-  return (dbus ++ others, bfs)
+--   return (dbus ++ others, bfs)
-  where
+--   where
-    ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
+--     ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] }
 
 usage :: IO ()
 usage = putStrLn $ intercalate "\n"

lib/XMonad/Internal/Command/DMenu.hs

@@ -72,7 +72,7 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity
 -- | Exported Commands
 
 runDevMenu :: FeatureX
-runDevMenu = featureDefault "device manager" [Executable myDmenuDevices] $ do
+runDevMenu = featureDefault "device manager" (Only $ exe myDmenuDevices) $ do
   c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
   spawnCmd myDmenuDevices
     $ ["-c", c]
@@ -84,11 +84,11 @@ runBTMenu = featureExeArgs "bluetooth selector" myDmenuBluetooth
   $ "-c":themeArgs "#0044bb"
 
 runBwMenu :: FeatureX
-runBwMenu = featureDefault "password manager" [Executable myDmenuPasswords] $
+runBwMenu = featureDefault "password manager" (Only $ exe myDmenuPasswords) $
   spawnCmd myDmenuPasswords $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
 
 runVPNMenu :: FeatureX
-runVPNMenu = featureDefault "VPN selector" [Executable myDmenuVPN] $
+runVPNMenu = featureDefault "VPN selector" (Only $ exe myDmenuVPN) $
   spawnCmd myDmenuVPN $ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
 
 -- TODO this is weirdly inverted
@@ -101,7 +101,7 @@ runShowKeys x = addName "Show Keybindings" $ do
 
 runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> FeatureX
 runDMenuShowKeys kbs =
-  featureDefault "keyboard shortcut menu" [Executable myDmenuCmd] $ io $ do
+  featureDefault "keyboard shortcut menu" (Only $ exe myDmenuCmd) $ io $ do
   (h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
   forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
   where
@@ -116,7 +116,7 @@ runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
 
 runClipMenu :: FeatureX
 runClipMenu =
-  featureDefault "clipboard manager" [Executable myDmenuCmd, Executable "greenclip"]
+  featureDefault "clipboard manager" (And (Only $ exe myDmenuCmd) (Only $ exe "greenclip"))
   $ spawnCmd myDmenuCmd args
   where
     args = [ "-modi", "\"clipboard:greenclip print\""

lib/XMonad/Internal/Command/Desktop.hs

@@ -97,7 +97,7 @@ runTerm = featureExe "terminal" myTerm
 runTMux :: FeatureX
 runTMux = featureDefault "terminal multiplexer" deps cmd
   where
-    deps = [Executable myTerm, Executable "tmux", Executable "bash"]
+    deps = listToAnds (exe myTerm) $ fmap exe ["tmux", "bash"]
     cmd = spawn
       $ "tmux has-session"
       #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
@@ -106,7 +106,7 @@ runTMux = featureDefault "terminal multiplexer" deps cmd
     msg = "could not connect to tmux session"
 
 runCalc :: FeatureX
-runCalc = featureDefault "calculator" [Executable myTerm, Executable "R"]
+runCalc = featureDefault "calculator" (And (Only $ exe myTerm) (Only $ exe "R"))
   $ spawnCmd myTerm ["-e", "R"]
 
 runBrowser :: FeatureX
@@ -153,7 +153,7 @@ playSound file = do
 
 featureSound :: String -> FilePath -> X () -> X () -> FeatureX
 featureSound n file pre post =
-  featureDefault ("volume " ++ n ++ " control") [Executable "paplay"]
+  featureDefault ("volume " ++ n ++ " control") (Only $ exe "paplay")
   $ pre >> playSound file >> post
 
 runVolumeDown :: FeatureX
@@ -192,7 +192,7 @@ runNotificationContext =
 
 runToggleBluetooth :: FeatureX
 runToggleBluetooth =
-  featureDefault "bluetooth toggle" [Executable myBluetooth]
+  featureDefault "bluetooth toggle" (Only $ exe myBluetooth)
   $ spawn
   $ myBluetooth ++ " show | grep -q \"Powered: no\""
   #!&& "a=on"
@@ -201,7 +201,7 @@ runToggleBluetooth =
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a"  }
 
 runToggleEthernet :: FeatureX
-runToggleEthernet = featureDefault "ethernet toggle" [Executable "nmcli"]
+runToggleEthernet = featureDefault "ethernet toggle" (Only $ exe "nmcli")
   $ spawn
   $ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected"
   #!&& "a=connect"
@@ -210,14 +210,14 @@ runToggleEthernet = featureDefault "ethernet toggle" [Executable "nmcli"]
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "ethernet \"$a\"ed"  }
 
 runStartISyncTimer :: FeatureX
-runStartISyncTimer = featureDefault "isync timer" [userUnit "mbsync.timer"]
+runStartISyncTimer = featureDefault "isync timer" (Only $ userUnit "mbsync.timer")
   $ spawn
   $ "systemctl --user start mbsync.timer"
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync timer started"  }
   #!|| fmtNotifyCmd defNoteError { body = Just $ Text "Isync timer failed to start" }
 
 runStartISyncService :: FeatureX
-runStartISyncService = featureDefault "isync" [userUnit "mbsync.service"]
+runStartISyncService = featureDefault "isync" (Only $ userUnit "mbsync.service")
   $ spawn
   $ "systemctl --user start mbsync.service"
   #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "Isync completed" }
@@ -262,7 +262,7 @@ getCaptureDir = do
     fallback = (</> ".local/share") <$> getHomeDirectory
 
 runFlameshot :: String -> String -> FeatureX
-runFlameshot n mode = featureDefault n [Executable myCapture]
+runFlameshot n mode = featureDefault n (Only $ exe myCapture)
   $ spawnCmd myCapture [mode]
 
 -- TODO this will steal focus from the current window (and puts it
@@ -280,6 +280,6 @@ runScreenCapture = runFlameshot "screen capture" "screen"
 
 runCaptureBrowser :: FeatureX
 runCaptureBrowser =
-  featureDefault "screen capture browser" [Executable myImageBrowser] $ do
+  featureDefault "screen capture browser" (Only $ exe myImageBrowser) $ do
   dir <- io getCaptureDir
   spawnCmd myImageBrowser [dir]

lib/XMonad/Internal/Command/Power.hs

@@ -101,7 +101,7 @@ runOptimusPrompt' = do
       #!&& "killall xmonad"
 
 runOptimusPrompt :: FeatureX
-runOptimusPrompt = featureDefault "graphics switcher" [Executable myOptimusManager]
+runOptimusPrompt = featureDefault "graphics switcher" (Only $ exe myOptimusManager)
   runOptimusPrompt'
 
 --------------------------------------------------------------------------------

lib/XMonad/Internal/Concurrent/ACPIEvent.hs

@@ -95,7 +95,7 @@ acpiPath = "/var/run/acpid.socket"
 -- | Spawn a new thread that will listen for ACPI events on the acpid socket
 -- and send ClientMessage events when it receives them
 runPowermon :: FeatureIO
-runPowermon = featureDefault "ACPI event monitor" [pathR acpiPath] listenACPI
+runPowermon = featureDefault "ACPI event monitor" (Only $ pathR acpiPath) listenACPI
 
 -- | Handle ClientMessage event containing and ACPI event (to be used in
 -- Xmonad's event hook)

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

@@ -107,10 +107,10 @@ clevoKeyboardConfig = BrightnessConfig
 --------------------------------------------------------------------------------
 -- | Exported haskell API
 
-stateFileDep :: Dependency
+stateFileDep :: FullDep Dependency
 stateFileDep = pathRW stateFile
 
-brightnessFileDep :: Dependency
+brightnessFileDep :: FullDep Dependency
 brightnessFileDep = pathR brightnessFile
 
 clevoKeyboardSignalDep :: DBusDep

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

@@ -85,11 +85,14 @@ matchSignal BrightnessConfig { bcPath = p, bcInterface = i } cb =
 --------------------------------------------------------------------------------
 -- | Internal DBus Crap
 
-brightnessExporter :: RealFrac b => [Dependency] -> BrightnessConfig a b
+brightnessExporter :: RealFrac b => [FullDep Dependency] -> BrightnessConfig a b
   -> Maybe Client -> FeatureIO
 brightnessExporter deps bc@BrightnessConfig { bcName = n } client = feature
   (n ++ " exporter") Default
-  $ DBusTree (Single (exportBrightnessControls' bc)) client [Bus xmonadBusName] deps
+  $ DBusTree (Single (exportBrightnessControls' bc)) client ds
+  where
+    ds = listToAnds (fullDep $ Bus xmonadBusName)
+      $ fmap (fmap DBusGenDep) deps
 
 exportBrightnessControls' :: RealFrac b => BrightnessConfig a b -> Client -> IO ()
 exportBrightnessControls' bc client = do

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

@@ -89,10 +89,10 @@ intelBacklightConfig = BrightnessConfig
 --------------------------------------------------------------------------------
 -- | Exported haskell API
 
-curFileDep :: Dependency
+curFileDep :: FullDep Dependency
 curFileDep = pathRW curFile
 
-maxFileDep :: Dependency
+maxFileDep :: FullDep Dependency
 maxFileDep = pathR maxFile
 
 intelBacklightSignalDep :: DBusDep

lib/XMonad/Internal/DBus/Removable.hs

@@ -32,13 +32,13 @@ memAdded = memberName_ "InterfacesAdded"
 memRemoved :: MemberName
 memRemoved = memberName_ "InterfacesRemoved"
 
-dbusDep :: MemberName -> DBusDep
+dbusDep :: MemberName -> FullDep DBusDep
-dbusDep m = Endpoint bus path interface $ Signal_ m
+dbusDep m = fullDep $ Endpoint bus path interface $ Signal_ m
 
-addedDep :: DBusDep
+addedDep :: FullDep DBusDep
 addedDep = dbusDep memAdded
 
-removedDep :: DBusDep
+removedDep :: FullDep DBusDep
 removedDep = dbusDep memRemoved
 
 driveInsertedSound :: FilePath
@@ -83,4 +83,4 @@ listenDevices client = do
 
 runRemovableMon :: Maybe Client -> FeatureIO
 runRemovableMon client = feature "removeable device monitor" Default
-  $ DBusTree (Single listenDevices) client [addedDep, removedDep] []
+  $ DBusTree (Single listenDevices) client $ And (Only addedDep) (Only removedDep)

lib/XMonad/Internal/DBus/Screensaver.hs

@@ -95,11 +95,8 @@ bodyGetCurrentState _   = Nothing
 -- | Exported haskell API
 
 exportScreensaver :: Maybe Client -> FeatureIO
-exportScreensaver client = Feature $ Feature_
+exportScreensaver client = feature "screensaver interface" Default
-  { ftrDepTree = DBusTree (Single cmd) client [Bus xmonadBusName] [Executable ssExecutable]
+  $ DBusTree (Single cmd) client (And (Only bus) (Only ssx))
-  , ftrName = "screensaver interface"
-  , ftrWarning = Default
-  }
   where
     cmd cl = export cl ssPath defaultInterface
       { interfaceName = interface
@@ -119,6 +116,8 @@ exportScreensaver client = Feature $ Feature_
           }
         ]
       }
+    bus = fullDep $ Bus xmonadBusName
+    ssx = fullDep $ DBusGenDep $ Executable ssExecutable
 
 callToggle :: Maybe Client -> FeatureIO
 callToggle =

lib/XMonad/Internal/Dependency.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor     #-}
 {-# LANGUAGE GADTs             #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -6,7 +7,10 @@
 
 module XMonad.Internal.Dependency
   ( MaybeAction
+  , AnyFeature(..)
+  , DepChoice(..)
   , MaybeX
+  , FullDep(..)
   , DepTree(..)
   , Action(..)
   , DBusDep(..)
@@ -37,6 +41,9 @@ module XMonad.Internal.Dependency
   , executeFeatureWith
   , executeFeatureWith_
   , depName
+  , fullDep
+  , exe
+  , listToAnds
   ) where
 
 import           Control.Monad.IO.Class
@@ -44,7 +51,7 @@ import           Control.Monad.Identity
 
 -- import           Data.Aeson
 import           Data.List               (find)
-import           Data.Maybe              (catMaybes, fromMaybe, listToMaybe)
+import           Data.Maybe
 -- import qualified Data.Text               as T
 
 import           DBus
@@ -90,7 +97,9 @@ data Feature_ a = Feature_
   , ftrWarning :: Warning
   }
 
-data Feature a = Feature (Feature_ a) | ConstFeature a
+data Feature a = Feature (Feature_ a) (Feature a)
+  | NoFeature
+  | ConstFeature a
 
 -- TODO this is silly as is, and could be made more useful by representing
 -- loglevels
@@ -100,8 +109,12 @@ type FeatureX = Feature (X ())
 
 type FeatureIO = Feature (IO ())
 
+data AnyFeature = FX FeatureX | FIO FeatureIO
+
 feature :: String -> Warning -> DepTree a -> Feature a
-feature n w t = Feature $ Feature_
+feature n w t = Feature f NoFeature
+  where
+    f = Feature_
       { ftrDepTree = t
       , ftrName = n
       , ftrWarning = w
@@ -109,9 +122,11 @@ feature n w t = Feature $ Feature_
 
 ioFeature :: MonadIO m => Feature (IO b) -> Feature (m b)
 ioFeature (ConstFeature a) = ConstFeature $ liftIO a
-ioFeature (Feature f)      = Feature $ f {ftrDepTree = liftIO <$> ftrDepTree f}
+ioFeature NoFeature = NoFeature
+ioFeature (Feature f r)
+  = Feature (f {ftrDepTree = liftIO <$> ftrDepTree f}) $ ioFeature r
 
-featureDefault :: String -> [Dependency] -> a -> Feature a
+featureDefault :: String -> DepChoice (FullDep Dependency) -> a -> Feature a
 featureDefault n ds x = feature n Default $ GenTree (Single x) ds
 
 featureExe :: MonadIO m => String -> String -> Feature (m ())
@@ -119,15 +134,15 @@ featureExe n cmd = featureExeArgs n cmd []
 
 featureExeArgs :: MonadIO m => String -> String -> [String] -> Feature (m ())
 featureExeArgs n cmd args =
-  featureDefault n [Executable cmd] $ spawnCmd cmd args
+  featureDefault n (Only $ FullDep (Right False) $ Executable cmd) $ spawnCmd cmd args
 
 featureEndpoint :: String -> BusName -> ObjectPath -> InterfaceName
   -> MemberName -> Maybe Client -> FeatureIO
 featureEndpoint name busname path iface mem client = feature name Default
-  $ DBusTree (Single cmd) client deps []
+  $ DBusTree (Single cmd) client deps
   where
     cmd c = void $ callMethod c busname path iface mem
-    deps = [Endpoint busname path iface $ Method_ mem]
+    deps = Only $ FullDep (Right False) $ Endpoint busname path iface $ Method_ mem
 
 --------------------------------------------------------------------------------
 -- | Dependency Trees
@@ -136,12 +151,19 @@ featureEndpoint name busname path iface mem client = feature name Default
 -- DBus client to evaluate (and will automatically fail if this is missing).
 -- The former can be evaluated independently.
 
-data DepTree a = GenTree (Action a) [Dependency]
+data DepChoice a = And (DepChoice a) (DepChoice a)
-  | DBusTree (Action (Client -> a)) (Maybe Client) [DBusDep] [Dependency]
+  | Or (DepChoice a) (DepChoice a)
+  | Only a
+
+listToAnds :: a -> [a] -> DepChoice a
+listToAnds i = foldr (And . Only) (Only i)
+
+data DepTree a = GenTree (Action a) (DepChoice (FullDep Dependency))
+  | DBusTree (Action (Client -> a)) (Maybe Client) (DepChoice (FullDep DBusDep))
 
 instance Functor DepTree where
   fmap f (GenTree a ds)    = GenTree (f <$> a) ds
-  fmap f (DBusTree a c es ds) = DBusTree (fmap (fmap f) a) c es ds
+  fmap f (DBusTree a c ds) = DBusTree (fmap (fmap f) a) c ds
 
 --------------------------------------------------------------------------------
 -- | Actions
@@ -169,9 +191,11 @@ type MaybeX = MaybeAction (X ())
 
 evalFeature :: Feature a -> IO (MaybeAction a)
 evalFeature (ConstFeature x) = return $ Just x
-evalFeature (Feature (Feature_{ftrDepTree = a, ftrName = n, ftrWarning = w})) = do
+evalFeature NoFeature = return Nothing
+-- TODO actually deal with alt
+evalFeature (Feature (Feature_{ftrDepTree = a, ftrName = n, ftrWarning = w}) _) = do
   procName <- getProgName
-  res <- evalTree a
+  res <- evalTree =<< evalTree' a
   either (printWarnings procName) (return . Just) res
   where
     printWarnings procName es = do
@@ -184,29 +208,92 @@ evalFeature (Feature (Feature_{ftrDepTree = a, ftrName = n, ftrWarning = w})) =
     fmtMsg procName msg = unwords [bracket procName, bracket "WARNING", msg]
     bracket s = "[" ++ s ++ "]"
 
+mapMDepChoice :: Monad m => (a -> m a) -> (a -> Bool) -> DepChoice a -> m (DepChoice a)
+mapMDepChoice f pass = fmap snd . go
+  where
+    go d@(And a b) = do
+      (ra, a') <- go a
+      if not ra then return (False, d) else do
+        (rb, b') <- go b
+        return $ if rb then (True, And a' b') else (False, d)
+    go d@(Or a b) = do
+      (ra, a') <- go a
+      if ra then return (True, Or a' b) else do
+        (rb, b') <- go b
+        return $ if rb then (True, Or a' b') else (False, d)
+    go d@(Only a)  = do
+      a' <- f a
+      return $ if pass a' then (True, Only a') else (False, d)
+
+-- foldDepChoice :: (a -> Bool) -> DepChoice a -> Bool
+-- foldDepChoice get dc = case dc of
+--   And a b -> go a && go b
+--   Or a b  -> go a || go b
+--   Only a  -> get a
+--   where
+--     go = foldDepChoice get
+
+foldDepChoice' :: Bool -> (a -> Maybe b) -> DepChoice a -> [b]
+foldDepChoice' justSucceed get = fromMaybe [] . go []
+  where
+    go acc (And a b) = Just $ andFun acc a b
+    go acc (Or a b)  = Just $ orFun acc a b
+    go acc (Only a)  = (:acc) <$> get a
+    (andFun, orFun) = if justSucceed then (and', or') else (or', and')
+    and' acc a b = case (go acc a, go acc b) of
+      (Just a', Just b') -> a' ++ b' ++ acc
+      (Just a', Nothing) -> a' ++ acc
+      (Nothing, _)       -> acc
+    or' acc a b = fromMaybe [] (go acc a) ++ fromMaybe [] (go acc b) ++ acc
+
+-- foldDepChoice :: DepChoice a -> (a -> Maybe b) -> [b]
+-- foldDepChoice dc f = go [] dc
+--   where
+--     go acc d = case d of
+--       And a b -> do
+--         acc'@(a':_) <- go acc a
+--         if pass a' then go acc' b else return acc
+--       Or a b  -> do
+--         acc'@(a':_) <- go acc a
+--         if pass a' then return [a'] else go acc' b
+--       Only a  -> maybe acc $ f a
+
+-- TODO wet code
 evalTree :: DepTree a -> IO (Either [String] a)
+evalTree (GenTree a ds) = do
+  case foldDepChoice' False fullDepMsg ds of
+      [] -> evalAction a
+      es -> return $ Left es
+evalTree (DBusTree a (Just client) ds) = do
+  case foldDepChoice' False fullDepMsg ds of
+    [] -> fmap (\f -> f client) <$> evalAction a
+    es -> return $ Left es
+evalTree (DBusTree _ Nothing _) = return $ Left ["client not available"]
 
-evalTree (GenTree action ds) = do
+fullDepMsg :: FullDep a -> Maybe String
-  es <- catMaybes <$> mapM evalDependency ds
+fullDepMsg (FullDep e _) = either Just (const Nothing) e
-  case es of
+
-    []  -> do
+evalTree' :: DepTree a -> IO (DepTree a)
-      action' <- evalAction action
+
-      return $ case action' of
+evalTree' (GenTree a ds) = GenTree a <$> mapMDepChoice eval pass ds
-        Right f  -> Right f
+  where
-        Left es' -> Left es'
+    eval (FullDep _ d) = do
-    es' -> return $ Left es'
+      r <- evalDependency d
+      return $ FullDep (maybe (Right True) Left r) d
+    pass (FullDep (Right True) _) = True
+    pass  _                       = True
+
+evalTree' d@(DBusTree _ Nothing _) = return d
+evalTree' (DBusTree a (Just client) ds) = DBusTree a (Just client) <$> mapMDepChoice eval pass ds
+  where
+    eval (FullDep _ d) = do
+      r <- eval' d
+      return $ FullDep (maybe (Right True) Left r) d
+    eval' (DBusGenDep d) = evalDependency d
+    eval' x              = dbusDepSatisfied client x
+    pass (FullDep (Right True) _) = True
+    pass  _                       = True
 
-evalTree (DBusTree _ Nothing _ _) = return $ Left ["client not available"]
-evalTree (DBusTree action (Just client) es ds) = do
-  eperrors <- mapM (dbusDepSatisfied client) es
-  dperrors <- mapM evalDependency ds
-  case catMaybes (eperrors ++ dperrors) of
-    []  -> do
-      action' <- evalAction action
-      return $ case action' of
-        Right f  -> Right $ f client
-        Left es' -> Left es'
-    es' -> return $ Left es'
 
 evalAction :: Action a -> IO (Either [String] a)
 evalAction (Single a)   = return $ Right a
@@ -236,27 +323,36 @@ ifSatisfied _ alt      = alt
 --------------------------------------------------------------------------------
 -- | Dependencies (General)
 
+data FullDep a = FullDep (Either String Bool) a deriving (Functor)
+
+fullDep :: a -> FullDep a
+fullDep = FullDep (Right True)
+
 data Dependency = Executable String
   | AccessiblePath FilePath Bool Bool
   | IOTest String (IO (Maybe String))
   | Systemd UnitType String
+  | DepFeature AnyFeature
 
 data UnitType = SystemUnit | UserUnit deriving (Eq, Show)
 
-pathR :: String -> Dependency
+exe :: String -> FullDep Dependency
-pathR n = AccessiblePath n True False
+exe = fullDep . Executable
 
-pathW :: String -> Dependency
+pathR :: String -> FullDep Dependency
-pathW n = AccessiblePath n False True
+pathR n = fullDep $ AccessiblePath n True False
 
-pathRW :: String -> Dependency
+pathW :: String -> FullDep Dependency
-pathRW n = AccessiblePath n True True
+pathW n = fullDep $ AccessiblePath n False True
 
-systemUnit :: String -> Dependency
+pathRW :: String -> FullDep Dependency
-systemUnit = Systemd SystemUnit
+pathRW n = fullDep $ AccessiblePath n True True
 
-userUnit :: String -> Dependency
+systemUnit :: String -> FullDep Dependency
-userUnit = Systemd UserUnit
+systemUnit = fullDep . Systemd SystemUnit
+
+userUnit :: String -> FullDep Dependency
+userUnit = fullDep . Systemd UserUnit
 
 --------------------------------------------------------------------------------
 -- | Dependencies (DBus)
@@ -269,7 +365,7 @@ data DBusMember = Method_ MemberName
 data DBusDep =
   Bus BusName
   | Endpoint BusName ObjectPath InterfaceName DBusMember
-  deriving (Eq, Show)
+  | DBusGenDep Dependency
 
 --------------------------------------------------------------------------------
 -- | Dependency evaluation (General)
@@ -282,6 +378,9 @@ evalDependency (Executable n)         = exeSatisfied n
 evalDependency (IOTest _ t)           = t
 evalDependency (Systemd t n)          = unitSatisfied t n
 evalDependency (AccessiblePath p r w) = pathSatisfied p r w
+evalDependency (DepFeature _)         = undefined
+-- TODO add something here to eval a nested feature's dependencies while
+-- bypassing the feature itself
 
 exeSatisfied :: String -> IO (Maybe String)
 exeSatisfied x = do
@@ -374,6 +473,8 @@ dbusDepSatisfied client (Endpoint busname objpath iface mem) = do
       , formatBusName busname
       ]
 
+dbusDepSatisfied _ (DBusGenDep d) = evalDependency d
+
 --------------------------------------------------------------------------------
 -- | Printing dependencies
 
@@ -410,4 +511,5 @@ depName (Systemd t n)          = "systemd (" ++ tp t ++ "): "  ++ n
     tp SystemUnit = "sys"
     tp UserUnit   = "user"
 depName (AccessiblePath p _ _) = "path: " ++ p
+depName (DepFeature _)         = "feature: blablabla"