summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormarkfine <>2017-11-13 23:18:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-11-13 23:18:00 (GMT)
commit5eaf3afe5663cbc12b4ea54db7a52a2788a8a283 (patch)
tree9f2f0b6a3862433c851bc21dd4817c72828e66b6
parentda40742d9193ab8205f8cb80a3e2c4d012f6269b (diff)
version 0.3.330.3.33
-rwxr-xr-xShakefile.hs2
-rw-r--r--src/Network/AWS/Wolf/Act.hs59
-rw-r--r--src/Network/AWS/Wolf/Count.hs7
-rw-r--r--src/Network/AWS/Wolf/Ctx.hs6
-rw-r--r--src/Network/AWS/Wolf/Decide.hs39
-rw-r--r--src/Network/AWS/Wolf/File.hs20
-rw-r--r--src/Network/AWS/Wolf/Types/Ctx.hs20
-rw-r--r--src/Network/AWS/Wolf/Types/Sum.hs3
-rw-r--r--wolf.cabal8
9 files changed, 67 insertions, 97 deletions
diff --git a/Shakefile.hs b/Shakefile.hs
index 14269e4..098f37d 100755
--- a/Shakefile.hs
+++ b/Shakefile.hs
@@ -38,7 +38,7 @@ main = shakeMain $ do
-- | sanity
--
fake "." pats "sanity" $ const $
- need [ "build-error", "lint" ]
+ need [ "build-error", "lint", "weed" ]
-- | Default things to run.
--
diff --git a/src/Network/AWS/Wolf/Act.hs b/src/Network/AWS/Wolf/Act.hs
index 1112089..5ba3652 100644
--- a/src/Network/AWS/Wolf/Act.hs
+++ b/src/Network/AWS/Wolf/Act.hs
@@ -75,36 +75,35 @@ check = maybe (pure False) (liftIO . doesFileExist)
act :: MonadConf c m => Text -> Bool -> Bool -> String -> m ()
act queue nocopy local command =
preConfCtx [ "label" .= LabelAct ] $
- runAmazonCtx $
- runAmazonWorkCtx queue $ do
- traceInfo "poll" mempty
- t0 <- liftIO getCurrentTime
- (token, uid, input) <- pollActivity
- t1 <- liftIO getCurrentTime
- statsIncrement "wolf.act.poll.count" [ "queue" =. queue ]
- statsHistogram "wolf.act.poll.elapsed" (realToFrac (diffUTCTime t1 t0) :: Double) [ "queue" =. queue ]
- maybe_ token $ \token' ->
- maybe_ uid $ \uid' ->
- withCurrentWorkDirectory uid' nocopy local $ \wd ->
- runAmazonStoreCtx uid' $ do
- traceInfo "start" [ "dir" .= wd ]
- t2 <- liftIO getCurrentTime
- dd <- dataDirectory wd
- sd <- storeDirectory wd
- isd <- inputDirectory sd
- osd <- outputDirectory sd
- writeJson (dd </> "control.json") (Control uid')
- writeText (dd </> "input.json") input
- download isd
- e <- run command
- upload osd
- output <- readText (dd </> "output.json")
- maybe (completeActivity token' output) (const $ failActivity token') e
- t3 <- liftIO getCurrentTime
- traceInfo "finish" [ "dir" .= wd ]
- let status = textFromString $ maybe "complete" (const "fail") e
- statsIncrement "wolf.act.activity.count" [ "queue" =. queue, "status" =. status ]
- statsHistogram "wolf.act.activity.elapsed" (realToFrac (diffUTCTime t3 t2) :: Double) [ "queue" =. queue ]
+ runAmazonWorkCtx queue $ do
+ traceInfo "poll" mempty
+ t0 <- liftIO getCurrentTime
+ (token, uid, input) <- pollActivity
+ t1 <- liftIO getCurrentTime
+ statsIncrement "wolf.act.poll.count" [ "queue" =. queue ]
+ statsHistogram "wolf.act.poll.elapsed" (realToFrac (diffUTCTime t1 t0) :: Double) [ "queue" =. queue ]
+ maybe_ token $ \token' ->
+ maybe_ uid $ \uid' ->
+ withCurrentWorkDirectory uid' nocopy local $ \wd ->
+ runAmazonStoreCtx uid' $ do
+ traceInfo "start" [ "dir" .= wd ]
+ t2 <- liftIO getCurrentTime
+ dd <- dataDirectory wd
+ sd <- storeDirectory wd
+ isd <- inputDirectory sd
+ osd <- outputDirectory sd
+ writeJson (dd </> "control.json") (Control uid')
+ writeText (dd </> "input.json") input
+ download isd
+ e <- run command
+ upload osd
+ output <- readText (dd </> "output.json")
+ maybe (completeActivity token' output) (const $ failActivity token') e
+ t3 <- liftIO getCurrentTime
+ traceInfo "finish" [ "dir" .= wd ]
+ let status = textFromString $ maybe "complete" (const "fail") e
+ statsIncrement "wolf.act.activity.count" [ "queue" =. queue, "status" =. status ]
+ statsHistogram "wolf.act.activity.elapsed" (realToFrac (diffUTCTime t3 t2) :: Double) [ "queue" =. queue ]
-- | Run actor from main with config file.
diff --git a/src/Network/AWS/Wolf/Count.hs b/src/Network/AWS/Wolf/Count.hs
index ba38074..9fb401b 100644
--- a/src/Network/AWS/Wolf/Count.hs
+++ b/src/Network/AWS/Wolf/Count.hs
@@ -41,10 +41,9 @@ countDecision t = do
--
count :: MonadConf c m => Plan -> m ()
count p =
- preConfCtx [ "label" .= LabelCount ] $
- runAmazonCtx $ do
- countDecision (p ^. pStart)
- mapM_ countActivity (p ^. pTasks)
+ preConfCtx [ "label" .= LabelCount ] $ do
+ countDecision (p ^. pStart)
+ mapM_ countActivity (p ^. pTasks)
-- | Run counter from main with config file.
--
diff --git a/src/Network/AWS/Wolf/Ctx.hs b/src/Network/AWS/Wolf/Ctx.hs
index 7148476..4c1d641 100644
--- a/src/Network/AWS/Wolf/Ctx.hs
+++ b/src/Network/AWS/Wolf/Ctx.hs
@@ -77,9 +77,9 @@ preConfCtx preamble action = do
-- | Run amazon context.
--
-runAmazonCtx :: MonadConf c m => TransT AmazonCtx m a -> m a
+runAmazonCtx :: MonadCtx c m => TransT AmazonCtx m a -> m a
runAmazonCtx action = do
- c <- view confCtx
+ c <- view ctx
#if MIN_VERSION_amazonka(1,4,5)
e <- newEnv Discover
#else
@@ -94,7 +94,7 @@ runAmazonStoreCtx uid action = do
let preamble = [ "uid" .= uid ]
c <- view confCtx <&> cPreamble <>~ preamble
p <- (-/- uid) . view cPrefix <$> view ccConf
- runBotTransT (AmazonStoreCtx c uid p) action
+ runBotTransT (AmazonStoreCtx c p) action
-- | Throttle throttle exceptions.
--
diff --git a/src/Network/AWS/Wolf/Decide.hs b/src/Network/AWS/Wolf/Decide.hs
index d945c98..041be15 100644
--- a/src/Network/AWS/Wolf/Decide.hs
+++ b/src/Network/AWS/Wolf/Decide.hs
@@ -88,26 +88,25 @@ schedule = do
--
decide :: MonadConf c m => Plan -> m ()
decide p =
- preConfCtx [ "label" .= LabelDecide ] $
- runAmazonCtx $ do
- let queue = p ^. pStart ^. tQueue
- runAmazonWorkCtx queue $ do
- traceInfo "poll" mempty
- t0 <- liftIO getCurrentTime
- (token, hes) <- pollDecision
- t1 <- liftIO getCurrentTime
- statsIncrement "wolf.decide.poll.count" [ "queue" =. queue ]
- statsHistogram "wolf.decide.poll.elapsed" (realToFrac (diffUTCTime t1 t0) :: Double) [ "queue" =. queue ]
- maybe_ token $ \token' ->
- runAmazonDecisionCtx p hes $ do
- traceInfo "start" mempty
- t2 <- liftIO getCurrentTime
- schedule >>=
- completeDecision token'
- t3 <- liftIO getCurrentTime
- traceInfo "finish" mempty
- statsIncrement "wolf.decide.decision.count" [ "queue" =. queue ]
- statsHistogram "wolf.decide.decision.elapsed" (realToFrac (diffUTCTime t3 t2) :: Double) [ "queue" =. queue ]
+ preConfCtx [ "label" .= LabelDecide ] $ do
+ let queue = p ^. pStart ^. tQueue
+ runAmazonWorkCtx queue $ do
+ traceInfo "poll" mempty
+ t0 <- liftIO getCurrentTime
+ (token, hes) <- pollDecision
+ t1 <- liftIO getCurrentTime
+ statsIncrement "wolf.decide.poll.count" [ "queue" =. queue ]
+ statsHistogram "wolf.decide.poll.elapsed" (realToFrac (diffUTCTime t1 t0) :: Double) [ "queue" =. queue ]
+ maybe_ token $ \token' ->
+ runAmazonDecisionCtx p hes $ do
+ traceInfo "start" mempty
+ t2 <- liftIO getCurrentTime
+ schedule >>=
+ completeDecision token'
+ t3 <- liftIO getCurrentTime
+ traceInfo "finish" mempty
+ statsIncrement "wolf.decide.decision.count" [ "queue" =. queue ]
+ statsHistogram "wolf.decide.decision.elapsed" (realToFrac (diffUTCTime t3 t2) :: Double) [ "queue" =. queue ]
-- | Run decider from main with config file.
--
diff --git a/src/Network/AWS/Wolf/File.hs b/src/Network/AWS/Wolf/File.hs
index 3de7f26..5396662 100644
--- a/src/Network/AWS/Wolf/File.hs
+++ b/src/Network/AWS/Wolf/File.hs
@@ -4,9 +4,7 @@
-- | Files, directories, and encoding / decoding file functions.
--
module Network.AWS.Wolf.File
- ( findRegularFiles
- , touchDirectory
- , dataDirectory
+ ( dataDirectory
, storeDirectory
, inputDirectory
, outputDirectory
@@ -22,24 +20,10 @@ import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Time
import Data.Yaml hiding (encode)
-import Network.AWS.Wolf.Prelude hiding (find)
+import Network.AWS.Wolf.Prelude
import System.Directory
-import System.FilePath
-import System.FilePath.Find
import System.IO hiding (readFile, writeFile)
--- | Recursively find all files under a directory.
---
-findRegularFiles :: MonadIO m => FilePath -> m [FilePath]
-findRegularFiles =
- liftIO . find always (fileType ==? RegularFile)
-
--- | Create parent directory of file if missing.
---
-touchDirectory :: MonadIO m => FilePath -> m ()
-touchDirectory =
- liftIO . createDirectoryIfMissing True . takeDirectory
-
-- | Determine path to data directory and create it.
--
dataDirectory :: MonadIO m => FilePath -> m FilePath
diff --git a/src/Network/AWS/Wolf/Types/Ctx.hs b/src/Network/AWS/Wolf/Types/Ctx.hs
index a324afa..d951be8 100644
--- a/src/Network/AWS/Wolf/Types/Ctx.hs
+++ b/src/Network/AWS/Wolf/Types/Ctx.hs
@@ -41,28 +41,22 @@ type MonadConf c m =
-- Amazon context.
--
data AmazonCtx = AmazonCtx
- { _acConfCtx :: ConfCtx
+ { _acCtx :: Ctx
-- ^ Parent context.
- , _acEnv :: Env
+ , _acEnv :: Env
-- ^ Amazon environment.
}
-$(makeClassyConstraints ''AmazonCtx [''HasConfCtx, ''HasEnv])
-
-instance HasConfCtx AmazonCtx where
- confCtx = acConfCtx
-
-instance HasStatsCtx AmazonCtx where
- statsCtx = confCtx . statsCtx
+$(makeClassyConstraints ''AmazonCtx [''HasCtx, ''HasEnv])
instance HasCtx AmazonCtx where
- ctx = statsCtx . ctx
+ ctx = acCtx
instance HasEnv AmazonCtx where
environment = acEnv
type MonadAmazon c m =
- ( MonadConf c m
+ ( MonadCtx c m
, HasAmazonCtx c
, AWSConstraint c m
)
@@ -74,8 +68,6 @@ type MonadAmazon c m =
data AmazonStoreCtx = AmazonStoreCtx
{ _ascConfCtx :: ConfCtx
-- ^ Parent context.
- , _ascUid :: Text
- -- ^ Workflow uid.
, _ascPrefix :: Text
-- ^ Object prefix.
}
@@ -83,7 +75,7 @@ data AmazonStoreCtx = AmazonStoreCtx
$(makeClassyConstraints ''AmazonStoreCtx [''HasConfCtx])
instance HasConfCtx AmazonStoreCtx where
- confCtx = ascConfCtx
+ confCtx = ascConfCtx
instance HasStatsCtx AmazonStoreCtx where
statsCtx = confCtx . statsCtx
diff --git a/src/Network/AWS/Wolf/Types/Sum.hs b/src/Network/AWS/Wolf/Types/Sum.hs
index 6af1638..82cf104 100644
--- a/src/Network/AWS/Wolf/Types/Sum.hs
+++ b/src/Network/AWS/Wolf/Types/Sum.hs
@@ -13,8 +13,7 @@ import Network.AWS.Wolf.Prelude
-- Tags for referencing workers.
--
data LabelType
- = LabelWolf
- | LabelAct
+ = LabelAct
| LabelDecide
| LabelCount
deriving (Show, Eq)
diff --git a/wolf.cabal b/wolf.cabal
index a651c70..920ffd3 100644
--- a/wolf.cabal
+++ b/wolf.cabal
@@ -1,5 +1,5 @@
name: wolf
-version: 0.3.32
+version: 0.3.33
cabal-version: >=1.22
build-type: Simple
license: MIT
@@ -28,13 +28,11 @@ library
bytestring >=0.10.6.0,
conduit >=1.2.10,
directory >=1.2.2.0,
- exceptions >=0.8.3,
- filemanip >=0.3.6.3,
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.51,
+ preamble >=0.0.52,
process >=1.2.3.0,
time >=1.5.0.1,
uuid >=1.3.13,
@@ -89,7 +87,7 @@ executable shake-wolf
main-is: Shakefile.hs
build-depends:
base >=4.8 && <5,
- shakers >=0.0.35
+ shakers >=0.0.36
default-language: Haskell2010
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall