diff --git a/src/Network/AWS/Wolf/Act.hs b/src/Network/AWS/Wolf/Act.hs --- a/src/Network/AWS/Wolf/Act.hs +++ b/src/Network/AWS/Wolf/Act.hs @@ -110,12 +110,11 @@ -- actMain :: MonadControl m => FilePath -> Maybe FilePath -> Text -> Int -> Bool -> Bool -> String -> m () actMain cf quiesce queue num nocopy local command = - runCtx $ - runStatsCtx $ do - conf <- readYaml cf - runConfCtx conf $ - runConcurrent $ replicate num $ forever $ do - ok <- check quiesce - when ok $ - liftIO exitSuccess - act queue nocopy local command + runCtx $ runTop $ do + conf <- readYaml cf + runConfCtx conf $ + runConcurrent $ replicate num $ forever $ do + ok <- check quiesce + when ok $ + liftIO exitSuccess + act queue nocopy local command diff --git a/src/Network/AWS/Wolf/Count.hs b/src/Network/AWS/Wolf/Count.hs --- a/src/Network/AWS/Wolf/Count.hs +++ b/src/Network/AWS/Wolf/Count.hs @@ -49,9 +49,8 @@ -- countMain :: MonadControl m => FilePath -> FilePath -> m () countMain cf pf = - runCtx $ - runStatsCtx $ do - conf <- readYaml cf - runConfCtx conf $ do - plans <- readYaml pf - mapM_ count (plans :: [Plan]) + runCtx $ runTop $ do + conf <- readYaml cf + runConfCtx conf $ do + plans <- readYaml pf + mapM_ count (plans :: [Plan]) diff --git a/src/Network/AWS/Wolf/Ctx.hs b/src/Network/AWS/Wolf/Ctx.hs --- a/src/Network/AWS/Wolf/Ctx.hs +++ b/src/Network/AWS/Wolf/Ctx.hs @@ -4,7 +4,8 @@ {-# LANGUAGE OverloadedStrings #-} module Network.AWS.Wolf.Ctx - ( runConfCtx + ( runTop + , runConfCtx , preConfCtx , runAmazonCtx , runAmazonStoreCtx @@ -43,18 +44,19 @@ -- topSomeExceptionCatch :: MonadStatsCtx c m => SomeException -> m a topSomeExceptionCatch ex = do + traceError "exception" [ "error" .= displayException ex ] statsIncrement "wolf.exception" [ "reason" =. textFromString (displayException ex) ] throwIO ex --- | Run bottom TransT. +-- | Run stats ctx. -- -runBotTransT :: (MonadControl m, HasCtx c) => c -> TransT c m a -> m a -runBotTransT c action = runTransT c $ catches action [ Handler botErrorCatch, Handler botSomeExceptionCatch ] +runTop :: MonadCtx c m => TransT StatsCtx m a -> m a +runTop action = runStatsCtx $ catch action topSomeExceptionCatch --- | Run top TransT. +-- | Run bottom TransT. -- -runTopTransT :: (MonadControl m, HasStatsCtx c) => c -> TransT c m a -> m a -runTopTransT c action = runBotTransT c $ catch action topSomeExceptionCatch +runTrans :: (MonadControl m, HasCtx c) => c -> TransT c m a -> m a +runTrans c action = runTransT c $ catches action [ Handler botErrorCatch, Handler botSomeExceptionCatch ] -- | Run configuration context. -- @@ -66,14 +68,14 @@ , "prefix" .= (conf ^. cPrefix) ] c <- view statsCtx <&> cPreamble <>~ preamble - runTopTransT (ConfCtx c conf) action + runTrans (ConfCtx c conf) action -- | Update configuration context's preamble. -- preConfCtx :: MonadConf c m => Pairs -> TransT ConfCtx m a -> m a preConfCtx preamble action = do c <- view confCtx <&> cPreamble <>~ preamble - runBotTransT c action + runTrans c action -- | Run amazon context. -- @@ -85,7 +87,7 @@ #else e <- newEnv Oregon Discover #endif - runBotTransT (AmazonCtx c e) action + runTrans (AmazonCtx c e) action -- | Run amazon store context. -- @@ -94,7 +96,7 @@ let preamble = [ "uid" .= uid ] c <- view confCtx <&> cPreamble <>~ preamble p <- (-/- uid) . view cPrefix <$> view ccConf - runBotTransT (AmazonStoreCtx c p) action + runTrans (AmazonStoreCtx c p) action -- | Throttle throttle exceptions. -- @@ -123,7 +125,7 @@ runAmazonWorkCtx queue action = do let preamble = [ "queue" .= queue ] c <- view confCtx <&> cPreamble <>~ preamble - runBotTransT (AmazonWorkCtx c queue) (catch action $ throttler action) + runTrans (AmazonWorkCtx c queue) (catch action $ throttler action) -- | Run amazon decision context. -- @@ -131,4 +133,4 @@ runAmazonDecisionCtx p hes action = do let preamble = [ "name" .= (p ^. pStart ^. tName) ] c <- view confCtx <&> cPreamble <>~ preamble - runBotTransT (AmazonDecisionCtx c p hes) action + runTrans (AmazonDecisionCtx c p hes) action diff --git a/src/Network/AWS/Wolf/Decide.hs b/src/Network/AWS/Wolf/Decide.hs --- a/src/Network/AWS/Wolf/Decide.hs +++ b/src/Network/AWS/Wolf/Decide.hs @@ -112,10 +112,9 @@ -- decideMain :: MonadControl m => FilePath -> FilePath -> m () decideMain cf pf = - runCtx $ - runStatsCtx $ do - conf <- readYaml cf - runConfCtx conf $ do - plans <- readYaml pf - runConcurrent $ - forever . decide <$> plans + runCtx $ runTop $ do + conf <- readYaml cf + runConfCtx conf $ do + plans <- readYaml pf + runConcurrent $ + forever . decide <$> plans diff --git a/wolf.cabal b/wolf.cabal --- a/wolf.cabal +++ b/wolf.cabal @@ -1,93 +1,84 @@ -name: wolf -version: 0.3.37 -cabal-version: >=1.22 -build-type: Simple -license: MIT -license-file: LICENSE -copyright: Copyright (C) 2015-2016 Swift Navigation, Inc. -maintainer: Mark Fine -homepage: https://github.com/swift-nav/wolf -synopsis: Amazon Simple Workflow Service Wrapper. -description: - Wolf is a wrapper around Amazon Simple Workflow Service. -category: Network, AWS, Cloud, Distributed Computing -author: Swift Navigation Inc. +name: wolf +version: 0.3.38 +synopsis: Amazon Simple Workflow Service Wrapper. +description: Wolf is a wrapper around Amazon Simple Workflow Service. +homepage: https://github.com/swift-nav/wolf +license: MIT +license-file: LICENSE +author: Swift Navigation Inc. +maintainer: Mark Fine +copyright: Copyright (C) 2015-2016 Swift Navigation, Inc. +category: Network, AWS, Cloud, Distributed Computing +build-type: Simple +cabal-version: >= 1.22 source-repository head - type: git - location: git@github.com:swift-nav/wolf.git + type: git + location: git@github.com:swift-nav/wolf.git library - exposed-modules: - Network.AWS.Wolf - build-depends: - aeson >=0.11.3.0, - amazonka >=1.4.3, - amazonka-swf >=1.4.3, - base >=4.8 && <5, - bytestring >=0.10.6.0, - conduit >=1.2.10, - directory >=1.2.2.0, - filepath >=1.4.0.0, - http-types >=0.9.1, - lifted-async >=0.9.1.1, - lifted-base >=0.2.3.11, - preamble >=0.0.53, - process >=1.2.3.0, - time >=1.5.0.1, - uuid >=1.3.13, - yaml >=0.8.23 - default-language: Haskell2010 - hs-source-dirs: src - other-modules: - Network.AWS.Wolf.Act - Network.AWS.Wolf.Count - Network.AWS.Wolf.Ctx - Network.AWS.Wolf.Decide - Network.AWS.Wolf.File - Network.AWS.Wolf.Prelude - Network.AWS.Wolf.SWF - Network.AWS.Wolf.Types - Network.AWS.Wolf.Types.Ctx - Network.AWS.Wolf.Types.Product - Network.AWS.Wolf.Types.Sum - ghc-options: -Wall + exposed-modules: Network.AWS.Wolf + other-modules: Network.AWS.Wolf.Act + , Network.AWS.Wolf.Count + , Network.AWS.Wolf.Ctx + , Network.AWS.Wolf.Decide + , Network.AWS.Wolf.File + , Network.AWS.Wolf.Prelude + , Network.AWS.Wolf.SWF + , Network.AWS.Wolf.Types + , Network.AWS.Wolf.Types.Ctx + , Network.AWS.Wolf.Types.Product + , Network.AWS.Wolf.Types.Sum + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall + build-depends: aeson + , amazonka + , amazonka-swf + , base >= 4.8 && < 5 + , bytestring + , conduit + , directory + , filepath + , http-types + , lifted-async + , lifted-base + , preamble + , process + , time + , uuid + , yaml executable wolf-actor - main-is: actor.hs - build-depends: - base >=4.8.2.0, - wolf, - optparse-generic >=1.1.5 - default-language: Haskell2010 - hs-source-dirs: main - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + hs-source-dirs: main + main-is: actor.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: base + , wolf + , optparse-generic + default-language: Haskell2010 executable wolf-decider - main-is: decider.hs - build-depends: - base >=4.8.2.0, - wolf, - optparse-generic >=1.1.5 - default-language: Haskell2010 - hs-source-dirs: main - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + hs-source-dirs: main + main-is: decider.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: base + , wolf + , optparse-generic + default-language: Haskell2010 executable wolf-counter - main-is: counter.hs - build-depends: - base >=4.8.2.0, - wolf, - optparse-generic >=1.1.5 - default-language: Haskell2010 - hs-source-dirs: main - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + hs-source-dirs: main + main-is: counter.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: base + , wolf + , optparse-generic + default-language: Haskell2010 executable shake-wolf - main-is: Shakefile.hs - build-depends: - base >=4.8 && <5, - shakers >=0.0.36 - default-language: Haskell2010 - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - + main-is: Shakefile.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: base >= 4.8 && < 5 + , shakers + default-language: Haskell2010