Revision f645af36
| b/src/Ganeti/Lens.hs | ||
|---|---|---|
| 27 | 27 |
( module Control.Lens |
| 28 | 28 |
, makeCustomLenses |
| 29 | 29 |
, makeCustomLenses' |
| 30 |
, traverseOf2 |
|
| 30 | 31 |
) where |
| 31 | 32 |
|
| 32 | 33 |
import Control.Lens |
| 33 | 34 |
import Control.Monad |
| 35 |
import Data.Functor.Compose (Compose(..)) |
|
| 34 | 36 |
import qualified Data.Set as S |
| 35 | 37 |
import Language.Haskell.TH |
| 36 | 38 |
|
| ... | ... | |
| 55 | 57 |
where |
| 56 | 58 |
allowed = S.fromList . map nameBase $ lst |
| 57 | 59 |
f = flip S.member allowed |
| 60 |
|
|
| 61 |
-- | Traverses over a composition of two functors. |
|
| 62 |
-- Most often the @g@ functor is @(,) r@ and 'traverseOf2' is used to |
|
| 63 |
-- traverse an effectful computation that also returns an additional output |
|
| 64 |
-- value. |
|
| 65 |
traverseOf2 :: Over (->) (Compose f g) s t a b |
|
| 66 |
-> (a -> f (g b)) -> s -> f (g t) |
|
| 67 |
traverseOf2 k f = getCompose . traverseOf k (Compose . f) |
|
| b/src/Ganeti/WConfd/Monad.hs | ||
|---|---|---|
| 61 | 61 |
import Control.Monad.Reader |
| 62 | 62 |
import Control.Monad.State |
| 63 | 63 |
import Control.Monad.Trans.Control |
| 64 |
import Data.Functor.Compose (Compose(..)) |
|
| 65 | 64 |
import Data.Functor.Identity |
| 66 | 65 |
import Data.IORef.Lifted |
| 67 | 66 |
import Data.Monoid (Any(..)) |
| ... | ... | |
| 240 | 239 |
modifyTempResStateErr f = do |
| 241 | 240 |
-- we use Compose to traverse the composition of applicative functors |
| 242 | 241 |
-- @ErrorResult@ and @(,) a@ |
| 243 |
let f' ds = getCompose $ traverseOf dsTempResL
|
|
| 244 |
(Compose . runStateT (f (csConfigData . dsConfigState $ ds))) ds
|
|
| 242 |
let f' ds = traverseOf2 dsTempResL
|
|
| 243 |
(runStateT (f (csConfigData . dsConfigState $ ds))) ds |
|
| 245 | 244 |
dh <- daemonHandle |
| 246 | 245 |
toErrorBase $ atomicModifyIORefErr (dhDaemonState dh) (liftM swap . f') |
| 247 | 246 |
|
Also available in: Unified diff