REF simplify Tree
This commit is contained in:
parent
c2923a7379
commit
caefbfc78a
|
@ -296,7 +296,7 @@ getEthernet :: Maybe Client -> BarFeature
|
||||||
getEthernet client = sometimes1 "ethernet status indicator" $
|
getEthernet client = sometimes1 "ethernet status indicator" $
|
||||||
DBusRoot (const . ethernetCmd) tree client
|
DBusRoot (const . ethernetCmd) tree client
|
||||||
where
|
where
|
||||||
tree = And1 id (Only readEth) (Only_ devDep)
|
tree = And1 (Only readEth) (Only_ devDep)
|
||||||
readEth = readInterface "read ethernet interface" isEthernet
|
readEth = readInterface "read ethernet interface" isEthernet
|
||||||
|
|
||||||
getBattery :: BarFeature
|
getBattery :: BarFeature
|
||||||
|
@ -316,7 +316,7 @@ getBt client = sometimesDBus client "bluetooth status indicator"
|
||||||
(const btCmd)
|
(const btCmd)
|
||||||
|
|
||||||
getAlsa :: BarFeature
|
getAlsa :: BarFeature
|
||||||
getAlsa = sometimesIO "volume level indicator" (Only_ $ sysExe "alsact") alsaCmd
|
getAlsa = sometimesIO "volume level indicator" (Only_ $ sysExe "alsactl") alsaCmd
|
||||||
|
|
||||||
getBl :: Maybe Client -> BarFeature
|
getBl :: Maybe Client -> BarFeature
|
||||||
getBl client = sometimesDBus client "Intel backlight indicator"
|
getBl client = sometimesDBus client "Intel backlight indicator"
|
||||||
|
|
|
@ -185,9 +185,9 @@ data Root a = forall p. IORoot (p -> a) (Tree IODependency IODependency_ p)
|
||||||
-- | The dependency tree with rules to merge results
|
-- | The dependency tree with rules to merge results
|
||||||
data Tree d d_ p =
|
data Tree d d_ p =
|
||||||
And12 (p -> p -> p) (Tree d d_ p) (Tree d d_ p)
|
And12 (p -> p -> p) (Tree d d_ p) (Tree d d_ p)
|
||||||
| And1 (p -> p) (Tree d d_ p) (Tree_ d_)
|
| And1 (Tree d d_ p) (Tree_ d_)
|
||||||
| And2 (p -> p) (Tree_ d_) (Tree d d_ p)
|
| And2 (Tree_ d_) (Tree d d_ p)
|
||||||
| Or (p -> p) (p -> p) (Tree d d_ p) (Tree d d_ p)
|
| Or (Tree d d_ p) (Tree d d_ p)
|
||||||
| Only (d p)
|
| Only (d p)
|
||||||
|
|
||||||
-- | A dependency tree without functions to merge results
|
-- | A dependency tree without functions to merge results
|
||||||
|
@ -324,36 +324,22 @@ type Result p = Either [String] (PostPass p)
|
||||||
testTree :: (d_ -> IO Result_) -> (d p -> IO (Result p)) -> Tree d d_ p
|
testTree :: (d_ -> IO Result_) -> (d p -> IO (Result p)) -> Tree d d_ p
|
||||||
-> IO (Either [String] (PostPass p))
|
-> IO (Either [String] (PostPass p))
|
||||||
testTree test_ test = go
|
testTree test_ test = go
|
||||||
-- TODO clean this up
|
|
||||||
where
|
where
|
||||||
go (And12 f a b) = either (return . Left) (\ra -> (and2nd f ra =<<) <$> go b)
|
go (And12 f a b) = do
|
||||||
=<< go a
|
|
||||||
go (And1 f a b) = do
|
|
||||||
ra <- go a
|
ra <- go a
|
||||||
case ra of
|
liftRight (\pa -> (and2nd f pa =<<) <$> go b) ra
|
||||||
(Right (PostPass pa wa)) -> do
|
go (And1 a b) = do
|
||||||
rb <- testTree_ test_ b
|
ra <- go a
|
||||||
return $ case rb of
|
liftRight (\p -> fmap (addMsgs p) <$> testTree_ test_ b) ra
|
||||||
(Left es) -> Left es
|
go (And2 a b) = do
|
||||||
(Right wb) -> Right $ PostPass (f pa) $ wa ++ wb
|
|
||||||
l -> return l
|
|
||||||
go (And2 f a b) = do
|
|
||||||
ra <- testTree_ test_ a
|
ra <- testTree_ test_ a
|
||||||
case ra of
|
liftRight (\wa -> fmap (`addMsgs` wa) <$> go b) ra
|
||||||
(Right wa) -> do
|
go (Or a b) = do
|
||||||
rb <- go b
|
|
||||||
return $ case rb of
|
|
||||||
(Left es) -> Left es
|
|
||||||
(Right (PostPass pb wb)) -> Right $ PostPass (f pb) $ wa ++ wb
|
|
||||||
(Left l) -> return $ Left l
|
|
||||||
go (Or fa fb a b) = do
|
|
||||||
ra <- go a
|
ra <- go a
|
||||||
case ra of
|
either (\ea -> fmap (`addMsgs` ea) <$> go b) (return . Right) ra
|
||||||
(Right (PostPass pa wa)) -> return $ Right $ PostPass (fa pa) wa
|
|
||||||
(Left ea) -> (or2nd fb ea =<<) <$> go b
|
|
||||||
go (Only a) = test a
|
go (Only a) = test a
|
||||||
and2nd f (PostPass pa wa) (PostPass pb wb) = Right $ PostPass (f pa pb) $ wa ++ wb
|
and2nd f (PostPass pa wa) (PostPass pb wb) = Right $ PostPass (f pa pb) $ wa ++ wb
|
||||||
or2nd f es (PostPass pb wb) = Right $ PostPass (f pb) $ es ++ wb
|
liftRight = either (return . Left)
|
||||||
|
|
||||||
testIODependency :: IODependency p -> IO (Result p)
|
testIODependency :: IODependency p -> IO (Result p)
|
||||||
testIODependency (IORead _ t) = t
|
testIODependency (IORead _ t) = t
|
||||||
|
|
Loading…
Reference in New Issue