diff --git a/main/actor.hs b/main/actor.hs --- a/main/actor.hs +++ b/main/actor.hs @@ -20,6 +20,8 @@ -- ^ Number of actors to run concurrently. , nocopy :: Bool -- ^ Copy working directory. + , local :: Bool + -- ^ Run locally, not in a temp directory. , command :: String -- ^ Command to run. } deriving (Show, Generic) @@ -36,4 +38,5 @@ (queue args) (fromMaybe 1 $ num args) (nocopy args) + (local args) (command args) 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 @@ -65,8 +65,8 @@ -- | Actor logic - poll for work, download artifacts, run command, upload artifacts. -- -act :: MonadConf c m => Text -> Bool -> String -> m () -act queue nocopy command = +act :: MonadConf c m => Text -> Bool -> Bool -> String -> m () +act queue nocopy local command = preConfCtx [ "label" .= LabelAct ] $ runAmazonCtx $ runAmazonWorkCtx queue $ do @@ -78,7 +78,7 @@ statsHistogram "wolf.act.poll.elapsed" (realToFrac (diffUTCTime t1 t0) :: Double) [ "queue" =. queue ] maybe_ token $ \token' -> maybe_ uid $ \uid' -> - withCurrentWorkDirectory uid' nocopy $ \wd -> + withCurrentWorkDirectory uid' nocopy local $ \wd -> runAmazonStoreCtx uid' $ do traceInfo "start" [ "dir" .= wd ] t2 <- liftIO getCurrentTime @@ -102,10 +102,10 @@ -- | Run actor from main with config file. -- -actMain :: MonadControl m => FilePath -> Text -> Int -> Bool -> String -> m () -actMain cf queue num nocopy command = +actMain :: MonadControl m => FilePath -> Text -> Int -> Bool -> Bool -> String -> m () +actMain cf queue num nocopy local command = runCtx $ runStatsCtx $ do conf <- readYaml cf runConfCtx conf $ - runConcurrent $ replicate num $ forever $ act queue nocopy command + runConcurrent $ replicate num $ forever $ act queue nocopy local command diff --git a/src/Network/AWS/Wolf/File.hs b/src/Network/AWS/Wolf/File.hs --- a/src/Network/AWS/Wolf/File.hs +++ b/src/Network/AWS/Wolf/File.hs @@ -104,10 +104,10 @@ -- | Get a temporary timestamped work directory. -- -getWorkDirectory :: MonadIO m => Text -> m FilePath -getWorkDirectory uid = +getWorkDirectory :: MonadIO m => Text -> Bool -> m FilePath +getWorkDirectory uid local = liftIO $ do - td <- getTemporaryDirectory + td <- bool getTemporaryDirectory getCurrentDirectory local time <- getCurrentTime let dir = td formatTime defaultTimeLocale "%FT%T%z" time textToString uid createDirectoryIfMissing True dir @@ -128,9 +128,9 @@ -- | Setup a temporary work directory. -- -withWorkDirectory :: MonadControl m => Text -> (FilePath -> m a) -> m a -withWorkDirectory uid = - bracket (getWorkDirectory uid) (liftIO . removeDirectoryRecursive) +withWorkDirectory :: MonadControl m => Text -> Bool -> (FilePath -> m a) -> m a +withWorkDirectory uid local = + bracket (getWorkDirectory uid local) (liftIO . removeDirectoryRecursive) -- | Change to directory and then return to current directory. -- @@ -142,11 +142,11 @@ -- | Setup a temporary work directory and copy current directory files to it. -- -withCurrentWorkDirectory :: MonadControl m => Text -> Bool -> (FilePath -> m a) -> m a -withCurrentWorkDirectory uid nocopy action = - withWorkDirectory uid $ \wd -> +withCurrentWorkDirectory :: MonadControl m => Text -> Bool -> Bool -> (FilePath -> m a) -> m a +withCurrentWorkDirectory uid nocopy local action = + withWorkDirectory uid local $ \wd -> withCurrentDirectory' wd $ \cd -> do - unless nocopy $ + unless (nocopy || local) $ copyDirectoryRecursive cd wd action wd diff --git a/src/Network/AWS/Wolf/Prelude.hs b/src/Network/AWS/Wolf/Prelude.hs --- a/src/Network/AWS/Wolf/Prelude.hs +++ b/src/Network/AWS/Wolf/Prelude.hs @@ -15,4 +15,4 @@ -- | Run a list of actions concurrently. -- runConcurrent :: MonadBaseControl IO m => [m a] -> m () -runConcurrent = void . runConcurrently . sequenceA . map Concurrently +runConcurrent = void . runConcurrently . traverse Concurrently diff --git a/wolf.cabal b/wolf.cabal --- a/wolf.cabal +++ b/wolf.cabal @@ -1,95 +1,86 @@ -name: wolf -version: 0.3.26 -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.27 +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, - 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.49, - 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 + , exceptions + , filemanip + , 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.31 - 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