wolf 0.3.18 → 0.3.19

raw patch · 8 files changed

+80/−96 lines, 8 filesdep −monad-controldep −resourcet

Dependencies removed: monad-control, resourcet

Files

• src/Network/AWS/Wolf/Act.hs +6/−7
• src/Network/AWS/Wolf/Count.hs +8/−9
• src/Network/AWS/Wolf/Ctx.hs +10/−10
• src/Network/AWS/Wolf/Decide.hs +7/−8
• src/Network/AWS/Wolf/Prelude.hs +0/−1
• src/Network/AWS/Wolf/SWF.hs +31/−23
• src/Network/AWS/Wolf/Types/Ctx.hs +17/−35
• wolf.cabal +1/−3

@@ -47,7 +47,7 @@  -- | callCommand wrapper that maybe returns an exception. ---callCommand' :: MonadMain m => String -> m (Maybe SomeException)+callCommand' :: MonadControl m => String -> m (Maybe SomeException) callCommand' command =   handle (return . Just) $ do     liftIO $ callCommand command@@ -104,9 +104,8 @@ -- actMain :: MonadControl m => FilePath -> Text -> String -> m () actMain cf queue command =-  runResourceT $-    runCtx $-      runStatsCtx $ do-        conf <- readYaml cf-        runConfCtx conf $-          forever $ act queue command+  runCtx $+    runStatsCtx $ do+      conf <- readYaml cf+      runConfCtx conf $+        forever $ act queue command

@@ -17,7 +17,7 @@  -- | Count pending activities. ---countActivity :: MonadAmazon c m => Task -> m ()+countActivity :: MonadConf c m => Task -> m () countActivity t = do   traceInfo "count-act" [ "task" .= t ]   let queue = t ^. tQueue@@ -28,7 +28,7 @@  -- | Count open workflows. ---countDecision :: MonadAmazon c m => Task -> m ()+countDecision :: MonadConf c m => Task -> m () countDecision t = do   traceInfo "count-decision" [ "task" .= t ]   let queue = t ^. tQueue@@ -50,10 +50,9 @@ -- countMain :: MonadControl m => FilePath -> FilePath -> m () countMain cf pf =-  runResourceT $-    runCtx $-      runStatsCtx $ do-        conf <- readYaml cf-        runConfCtx conf $ do-          plans <- readYaml pf-          mapM_ count (plans :: [Plan])+  runCtx $+    runStatsCtx $ do+      conf <- readYaml cf+      runConfCtx conf $ do+        plans <- readYaml pf+        mapM_ count (plans :: [Plan])

@@ -47,12 +47,12 @@  -- | Run bottom TransT. ---runBotTransT :: (MonadMain m, HasCtx c) => c -> TransT c m a -> m a+runBotTransT :: (MonadControl m, HasCtx c) => c -> TransT c m a -> m a runBotTransT c action = runTransT c $ catches action [ Handler botErrorCatch, Handler botSomeExceptionCatch ]  -- | Run top TransT. ---runTopTransT :: (MonadMain m, HasStatsCtx c) => c -> TransT c m a -> m a+runTopTransT :: (MonadControl m, HasStatsCtx c) => c -> TransT c m a -> m a runTopTransT c action = runBotTransT c $ catch action topSomeExceptionCatch  -- | Run configuration context.@@ -84,16 +84,16 @@  -- | Run amazon store context. ---runAmazonStoreCtx :: MonadAmazon c m => Text -> TransT AmazonStoreCtx m a -> m a+runAmazonStoreCtx :: MonadConf c m => Text -> TransT AmazonStoreCtx m a -> m a runAmazonStoreCtx uid action = do   let preamble = [ "uid" .= uid ]-  c <- view amazonCtx <&> cPreamble <>~ preamble+  c <- view confCtx <&> cPreamble <>~ preamble   p <- (-/- uid) . view cPrefix <$> view ccConf   runBotTransT (AmazonStoreCtx c uid p) action  -- | Throttle throttle exceptions. ---throttled :: MonadAmazon c m => m a -> m a+throttled :: MonadStatsCtx c m => m a -> m a throttled action = do   traceError "throttled" mempty   statsIncrement "wolf.throttled" mempty@@ -102,7 +102,7 @@  -- | Amazon throttle handler. ---throttler :: MonadAmazon c m => m a -> Error -> m a+throttler :: MonadStatsCtx c m => m a -> Error -> m a throttler action e =   case e of     ServiceError se ->@@ -114,16 +114,16 @@  -- | Run amazon work context. ---runAmazonWorkCtx :: MonadAmazon c m => Text -> TransT AmazonWorkCtx m a -> m a+runAmazonWorkCtx :: MonadConf c m => Text -> TransT AmazonWorkCtx m a -> m a runAmazonWorkCtx queue action = do   let preamble = [ "queue" .= queue ]-  c <- view amazonCtx <&> cPreamble <>~ preamble+  c <- view confCtx <&> cPreamble <>~ preamble   runBotTransT (AmazonWorkCtx c queue) (catch action $ throttler action)  -- | Run amazon decision context. ---runAmazonDecisionCtx :: MonadAmazon c m => Plan -> [HistoryEvent] -> TransT AmazonDecisionCtx m a -> m a+runAmazonDecisionCtx :: MonadConf c m => Plan -> [HistoryEvent] -> TransT AmazonDecisionCtx m a -> m a runAmazonDecisionCtx p hes action = do   let preamble = [ "name" .= (p ^. pStart ^. tName) ]-  c <- view amazonCtx <&> cPreamble <>~ preamble+  c <- view confCtx <&> cPreamble <>~ preamble   runBotTransT (AmazonDecisionCtx c p hes) action

@@ -113,11 +113,10 @@ -- decideMain :: MonadControl m => FilePath -> FilePath -> m () decideMain cf pf =-  runResourceT $-    runCtx $-      runStatsCtx $ do-        conf <- readYaml cf-        runConfCtx conf $ do-          plans <- readYaml pf-          runConcurrent $-            forever . decide <$> plans+  runCtx $+    runStatsCtx $ do+      conf <- readYaml cf+      runConfCtx conf $ do+        plans <- readYaml pf+        runConcurrent $+          forever . decide <$> plans

@@ -10,7 +10,6 @@   ) where  import Control.Concurrent.Async.Lifted-import Control.Monad.Trans.Control import Preamble                        as Exports  -- | Run a list of actions concurrently.

@@ -20,6 +20,7 @@ import Data.Conduit import Data.Conduit.List        hiding (concatMap, map) import Network.AWS.SWF+import Network.AWS.Wolf.Ctx import Network.AWS.Wolf.Prelude import Network.AWS.Wolf.Types @@ -27,14 +28,15 @@ -- pollActivity :: MonadAmazonWork c m => m (Maybe Text, Maybe Text, Maybe Text) pollActivity = do-  d      <- view cDomain <$> view ccConf-  tl     <- taskList <$> view awcQueue-  pfatrs <- send (pollForActivityTask d tl)-  return-    ( pfatrs ^. pfatrsTaskToken-    , view weWorkflowId <$> pfatrs ^. pfatrsWorkflowExecution-    , pfatrs ^. pfatrsInput-    )+  d  <- view cDomain <$> view ccConf+  tl <- taskList <$> view awcQueue+  runResourceT $ runAmazonCtx $ do+    pfatrs <- send (pollForActivityTask d tl)+    return+      ( pfatrs ^. pfatrsTaskToken+      , view weWorkflowId <$> pfatrs ^. pfatrsWorkflowExecution+      , pfatrs ^. pfatrsInput+      )  -- | Poll for decisions. --@@ -42,11 +44,12 @@ pollDecision = do   d      <- view cDomain <$> view ccConf   tl     <- taskList <$> view awcQueue-  pfdtrs <- paginate (pollForDecisionTask d tl) $$ consume-  return-    ( join $ headMay $ map (view pfdtrsTaskToken) pfdtrs-    , reverse $ concatMap (view pfdtrsEvents) pfdtrs-    )+  runResourceT $ runAmazonCtx $ do+    pfdtrs <- paginate (pollForDecisionTask d tl) $$ consume+    return+      ( join $ headMay $ map (view pfdtrsTaskToken) pfdtrs+      , reverse $ concatMap (view pfdtrsEvents) pfdtrs+      )  -- | Count activities. --@@ -54,8 +57,9 @@ countActivities = do   d   <- view cDomain <$> view ccConf   tl  <- taskList <$> view awcQueue-  ptc <- send (countPendingActivityTasks d tl)-  return $ fromIntegral (ptc ^. ptcCount)+  runResourceT $ runAmazonCtx $ do+    ptc <- send (countPendingActivityTasks d tl)+    return $ fromIntegral (ptc ^. ptcCount)  -- | Count decisions. --@@ -63,26 +67,30 @@ countDecisions = do   d   <- view cDomain <$> view ccConf   tl  <- taskList <$> view awcQueue-  ptc <- send (countPendingDecisionTasks d tl)-  return $ fromIntegral (ptc ^. ptcCount)+  runResourceT $ runAmazonCtx $ do+    ptc <- send (countPendingDecisionTasks d tl)+    return $ fromIntegral (ptc ^. ptcCount)  -- | Successful job completion. ---completeActivity :: MonadAmazon c m => Text -> Maybe Text -> m ()+completeActivity :: MonadConf c m => Text -> Maybe Text -> m () completeActivity token output =-  void $ send $ set ratcResult output $ respondActivityTaskCompleted token+  runResourceT $ runAmazonCtx $+    void $ send $ set ratcResult output $ respondActivityTaskCompleted token  -- | Job failure. ---failActivity :: MonadAmazon c m => Text -> m ()+failActivity :: MonadConf c m => Text -> m () failActivity token =-  void $ send $ respondActivityTaskFailed token+  runResourceT $ runAmazonCtx $+    void $ send $ respondActivityTaskFailed token  -- | Successful decision completion. ---completeDecision :: MonadAmazon c m => Text -> Decision -> m ()+completeDecision :: MonadConf c m => Text -> Decision -> m () completeDecision token d =-  void $ send $ set rdtcDecisions (return d) $ respondDecisionTaskCompleted token+  runResourceT $ runAmazonCtx $+    void $ send $ set rdtcDecisions (return d) $ respondDecisionTaskCompleted token  -- | Schedule decision. --

@@ -72,21 +72,18 @@ -- Amazon store context. -- data AmazonStoreCtx = AmazonStoreCtx-  { _ascAmazonCtx :: AmazonCtx+  { _ascConfCtx :: ConfCtx     -- ^ Parent context.-  , _ascUid       :: Text+  , _ascUid     :: Text     -- ^ Workflow uid.-  , _ascPrefix    :: Text+  , _ascPrefix  :: Text     -- ^ Object prefix.   } -$(makeClassyConstraints ''AmazonStoreCtx [''HasAmazonCtx])--instance HasAmazonCtx AmazonStoreCtx where-  amazonCtx = ascAmazonCtx+$(makeClassyConstraints ''AmazonStoreCtx [''HasConfCtx])  instance HasConfCtx AmazonStoreCtx where-   confCtx = amazonCtx . acConfCtx+   confCtx = ascConfCtx  instance HasStatsCtx AmazonStoreCtx where   statsCtx = confCtx . statsCtx@@ -94,11 +91,8 @@ instance HasCtx AmazonStoreCtx where   ctx = statsCtx . ctx -instance HasEnv AmazonStoreCtx where-   environment = amazonCtx . acEnv- type MonadAmazonStore c m =-   ( MonadAmazon c m+   ( MonadConf c m    , HasAmazonStoreCtx c    ) @@ -107,19 +101,16 @@ -- Amazon work context. -- data AmazonWorkCtx = AmazonWorkCtx-  { _awcAmazonCtx :: AmazonCtx+  { _awcConfCtx :: ConfCtx     -- ^ Parent context.-  , _awcQueue     :: Text+  , _awcQueue   :: Text     -- ^ Workflow queue.   } -$(makeClassyConstraints ''AmazonWorkCtx [''HasAmazonCtx])--instance HasAmazonCtx AmazonWorkCtx where-  amazonCtx = awcAmazonCtx+$(makeClassyConstraints ''AmazonWorkCtx [''HasConfCtx])  instance HasConfCtx AmazonWorkCtx where-   confCtx = amazonCtx . acConfCtx+   confCtx = awcConfCtx  instance HasStatsCtx AmazonWorkCtx where   statsCtx = confCtx . statsCtx@@ -127,11 +118,8 @@ instance HasCtx AmazonWorkCtx where   ctx = statsCtx . ctx -instance HasEnv AmazonWorkCtx where-   environment = amazonCtx . acEnv- type MonadAmazonWork c m =-   ( MonadAmazon c m+   ( MonadConf c m    , HasAmazonWorkCtx c    ) @@ -140,21 +128,18 @@ -- Amazon decision context. -- data AmazonDecisionCtx = AmazonDecisionCtx-  { _adcAmazonCtx :: AmazonCtx+  { _adcConfCtx :: ConfCtx     -- ^ Parent context.-  , _adcPlan      :: Plan+  , _adcPlan    :: Plan     -- ^ Decision plan.-  , _adcEvents    :: [HistoryEvent]+  , _adcEvents  :: [HistoryEvent]     -- ^ History events.   } -$(makeClassyConstraints ''AmazonDecisionCtx [''HasAmazonCtx])--instance HasAmazonCtx AmazonDecisionCtx where-  amazonCtx = adcAmazonCtx+$(makeClassyConstraints ''AmazonDecisionCtx [''HasConfCtx])  instance HasConfCtx AmazonDecisionCtx where-   confCtx = amazonCtx . acConfCtx+   confCtx = adcConfCtx  instance HasStatsCtx AmazonDecisionCtx where   statsCtx = confCtx . statsCtx@@ -162,11 +147,8 @@ instance HasCtx AmazonDecisionCtx where   ctx = statsCtx . ctx -instance HasEnv AmazonDecisionCtx where-   environment = amazonCtx . acEnv- type MonadAmazonDecision c m =-   ( MonadAmazon c m+   ( MonadConf c m    , HasAmazonDecisionCtx c    ) 

@@ -1,5 +1,5 @@ name:                  wolf-version:               0.3.18+version:               0.3.19 synopsis:              Amazon Simple Workflow Service Wrapper. description:           Wolf is a wrapper around Amazon Simple Workflow Service. homepage:              https://github.com/swift-nav/wolf@@ -45,10 +45,8 @@                      , http-types                      , lifted-async                      , lifted-base-                     , monad-control                      , preamble                      , process-                     , resourcet                      , time                      , uuid                      , yaml