packages feed

loup 0.0.7 → 0.0.8

raw patch · 4 files changed

+51/−26 lines, 4 files

Files

loup.cabal view
@@ -1,5 +1,5 @@ name:                  loup-version:               0.0.7+version:               0.0.8 synopsis:              Amazon Simple Workflow Service Wrapper for Work Pools. description:           Loup is a wrapper around Amazon Simple Workflow Service for Work Pools. homepage:              https://github.com/swift-nav/loup
src/Network/AWS/Loup/Act.hs view
@@ -5,13 +5,15 @@ -- | SWF Actor logic. -- module Network.AWS.Loup.Act-  ( act+  ( activity+  , act   , actMain   ) where  import Control.Concurrent import Control.Concurrent.Async.Lifted import Control.Monad.Trans.AWS+import Data.Yaml import Network.AWS.Loup.Ctx import Network.AWS.Loup.Prelude import Network.AWS.Loup.Types@@ -73,25 +75,33 @@  -- | Run command with input. ---runActivity :: MonadStatsCtx c m => Text -> Bool -> Text -> Maybe Text -> m ()-runActivity token copy command input = do-  traceInfo "run" [ "command" .= command, "input" .= input]+runActivity :: MonadStatsCtx c m => Bool -> Text -> Text -> Maybe Value -> m ()+runActivity copy command token input = do+  traceInfo "run" [ "command" .= command, "input" .= input ]   intempdir copy $ do-    liftIO $ maybe_ input $ writeTextFile "input.json"+    liftIO $ maybe_ input $ encodeFile "input.json"     stderr $ inshell command mempty   failActivity token  -- | Actor logic - poll for work, download artifacts, run command, upload artifacts. --+activity :: (MonadStatsCtx c m, FromJSON a) => Text -> Text -> Int -> (Text -> Maybe a -> m b) -> m ()+activity domain queue interval action = do+  traceInfo "poll" mempty+  (token, input) <- pollActivity domain (taskList queue)+  maybe_ token $ \token' -> do+    traceInfo "start" mempty+    let input' = join $ decode . encodeUtf8 <$> input+    race_ (runHeartbeat token' interval) (action token' input')+    traceInfo "finish" mempty++-- | Activity setup fom main.+-- act :: MonadStatsCtx c m => Text -> Text -> Int -> Bool -> Text -> m () act domain queue interval copy command =-  preStatsCtx [ "label" .= LabelAct, "domain" .= domain, "queue" .= queue ] $ do-    traceInfo "poll" mempty-    (token, input) <- pollActivity domain (taskList queue)-    maybe_ token $ \token' -> do-      traceInfo "start" mempty-      race_ (runHeartbeat token' interval) (runActivity token' copy command input)-      traceInfo "finish" mempty+  preStatsCtx [ "label" .= LabelAct, "domain" .= domain, "queue" .= queue ] $+    activity domain queue interval $+      runActivity copy command  -- | Run actor from main with configuration. --
src/Network/AWS/Loup/Converge.hs view
@@ -5,7 +5,8 @@ -- | SWF Converger logic. -- module Network.AWS.Loup.Converge-  ( converge+  ( converging+  , converge   , convergeMain   ) where @@ -48,8 +49,8 @@  -- | Converger logic - get running workers and converge against pool. ---converge :: MonadStatsCtx c m => Text -> Pool -> m ()-converge domain pool =+converging :: MonadStatsCtx c m => Text -> Pool -> m ()+converging domain pool =   preStatsCtx [ "label" .= LabelDecide, "domain" .= domain ] $ do     let activity = pool ^. pTask ^. tActivityType     wids <- fromList <$> listWorkflows domain activity@@ -64,6 +65,13 @@     forM_ wids' $ \wid -> do       traceInfo "cancel" [ "wid" .= wid ]       cancelWorkflow domain wid++-- | Converging setup from main.+--+converge :: MonadStatsCtx c m => Text -> Pool -> m ()+converge domain pool =+  preStatsCtx [ "label" .= LabelDecide, "domain" .= domain ] $+    converging domain pool  -- | Run converger from main with configuration. --
src/Network/AWS/Loup/Decide.hs view
@@ -5,7 +5,8 @@ -- | SWF Decider logic. -- module Network.AWS.Loup.Decide-  ( decide+  ( deciding+  , decide   , decideMain   ) where @@ -149,17 +150,23 @@  -- | Decider logic - poll for decisions, make decisions. --+deciding :: MonadStatsCtx c m => Text -> Plan -> m ()+deciding domain plan = do+  traceInfo "poll" mempty+  (token, events) <- pollDecision domain (plan ^. pDecisionTask ^. tTaskList)+  maybe_ token $ \token' -> do+    traceInfo "start" mempty+    runDecisionCtx plan events $ do+      decisions <- schedule+      completeDecision token' decisions+    traceInfo "finish" mempty++-- | Deciding setup from main.+-- decide :: MonadStatsCtx c m => Text -> Plan -> m () decide domain plan =-  preStatsCtx [ "label" .= LabelDecide, "domain" .= domain ] $ do-    traceInfo "poll" mempty-    (token, events) <- pollDecision domain (plan ^. pDecisionTask ^. tTaskList)-    maybe_ token $ \token' -> do-      traceInfo "start" mempty-      runDecisionCtx plan events $ do-        decisions <- schedule-        completeDecision token' decisions-      traceInfo "finish" mempty+  preStatsCtx [ "label" .= LabelDecide, "domain" .= domain ] $+    deciding domain plan  -- | Run decider from main with configuration. --