packages feed

wolf 0.3.0 → 0.3.1

raw patch · 17 files changed

+40/−376 lines, 17 filesdep +preamble

Dependencies added: preamble

Files

Shakefile.hs view
@@ -173,6 +173,7 @@   -- | build   --   fake pats "build" $ \_files -> do+    need [ "wolf.cabal" ]     stack [ "build", "--fast" ]    -- | build-error
src/Network/AWS/Wolf/Act.hs view
@@ -13,7 +13,6 @@ import Network.AWS.Wolf.Prelude import Network.AWS.Wolf.S3 import Network.AWS.Wolf.SWF-import Network.AWS.Wolf.Trace import Network.AWS.Wolf.Types import System.Process
− src/Network/AWS/Wolf/Aeson.hs 
@@ -1,47 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}---- | Aeson generic deriving options.----module Network.AWS.Wolf.Aeson-  ( camelOptions-  , snakeOptions-  , spinalOptions-  ) where--import Data.Aeson.Types-import Data.Char-import Data.Text-import Data.Text.Manipulate-import Network.AWS.Wolf.Prelude hiding (dropWhile)---- | Remove characters up to the first upper case character.----unprefix :: Text -> Text-unprefix = dropWhile (not . isUpper)---- | Derive fields with camelCase.----camelOptions :: Options-camelOptions = defaultOptions-  { fieldLabelModifier     = unpack . toCamel . unprefix . pack-  , constructorTagModifier = unpack . toCamel . unprefix . lowerHead . pack-  , omitNothingFields      = True-  }---- | Derive fields with snake_case.----snakeOptions :: Options-snakeOptions = defaultOptions-  { fieldLabelModifier     = unpack . toSnake . unprefix . pack-  , constructorTagModifier = unpack . toSnake . unprefix . lowerHead . pack-  , omitNothingFields      = True-  }---- | Derive fields with spinal-case.----spinalOptions :: Options-spinalOptions = defaultOptions-  { fieldLabelModifier     = unpack . toSpinal . unprefix . pack-  , constructorTagModifier = unpack . toSpinal . unprefix . lowerHead . pack-  , omitNothingFields      = True-  }
src/Network/AWS/Wolf/Ctx.hs view
@@ -14,34 +14,11 @@   , preAmazonWorkCtx   ) where -import Control.Monad.Logger-import Control.Monad.Reader import Control.Monad.Trans.AWS import Data.Aeson import Network.AWS.Wolf.Prelude-import Network.AWS.Wolf.Trace import Network.AWS.Wolf.Types --- | Run monad transformer, picking up logger from context.----runTransT :: HasCtx c => c -> TransT c m a -> m a-runTransT c m =-  runReaderT (runLoggingT (unTransT m) (c ^. cTrace)) c---- | Run base context.----runCtx :: MonadIO m => TransT Ctx m a -> m a-runCtx action = do-  t <- liftIO $ newStderrTrace LevelInfo-  runTransT (Ctx mempty t) action---- | Update base context's preamble.----preCtx :: MonadCtx c m => Pairs -> TransT Ctx m a -> m a-preCtx preamble action = do-  c <- view ctx <&> cPreamble <>~ preamble-  runTransT c action- -- | Run configuration context. -- runConfCtx :: MonadCtx c m => Conf -> TransT ConfCtx m a -> m a@@ -82,7 +59,7 @@ runAmazonStoreCtx uid action = do   let preamble = [ "uid" .= uid ]   c <- view amazonCtx <&> cPreamble <>~ preamble-  p <- (<\> uid) . view cPrefix <$> view ccConf+  p <- (-/- uid) . view cPrefix <$> view ccConf   runTransT (AmazonStoreCtx c uid p) action  -- | Update amazon context's preamble.
src/Network/AWS/Wolf/Decide.hs view
@@ -12,7 +12,6 @@ import Network.AWS.Wolf.File import Network.AWS.Wolf.Prelude import Network.AWS.Wolf.SWF-import Network.AWS.Wolf.Trace import Network.AWS.Wolf.Types  -- | Decider logic - poll for decisions, make decisions.
− src/Network/AWS/Wolf/Lens.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}---- | makeClassy with constraints.----module Network.AWS.Wolf.Lens-  ( makeClassyConstraints-  ) where--import Language.Haskell.TH-import Network.AWS.Wolf.Prelude---- | makeClassy with list of class constraints.----makeClassyConstraints :: Name -> [Name] -> DecsQ-makeClassyConstraints name names = do-  decls <- makeClassy name-  return $ addConstraints names decls---- | Add constaints to a class.----addConstraints :: [Name] -> [Dec] -> [Dec]-addConstraints names = \case-  ClassD cs n tvs f d : ds ->-    ClassD (newConstraints names tvs ++ cs) n tvs f d : ds-  ds -> ds---- | Create new constaints.----newConstraints :: [Name] -> [TyVarBndr] -> [Type]-newConstraints ns =-  loop where-    loop = \case-      PlainTV name : _tvs ->-        flip map ns $ \n ->-          AppT (ConT n) (VarT name)-      _tv : tvs -> loop tvs-      [] -> []
src/Network/AWS/Wolf/Prelude.hs view
@@ -7,54 +7,29 @@ module Network.AWS.Wolf.Prelude   ( module Exports   , runResourceT-  , maybe_-  , eitherThrowIO   , runConcurrent-  , textFromString   , stripPrefix'-  , (<\>)   , MonadBaseControlIO   , MonadMain   ) where -import BasicPrelude                    as Exports hiding (stripPrefix) import Control.Concurrent.Async.Lifted-import Control.Lens                    as Exports hiding (uncons, (.=), (<.>)) import Control.Monad.Catch import Control.Monad.Trans.Control import Control.Monad.Trans.Resource import Data.Text                       hiding (map)---- | Maybe that returns () if Nothing----maybe_ :: Monad m => Maybe a -> (a -> m ()) -> m ()-maybe_ = flip $ maybe $ return ()---- | Throw userError on either error.----eitherThrowIO :: MonadIO m => Either String a -> m a-eitherThrowIO = either (liftIO . throwIO . userError) return+import Preamble                        as Exports hiding (stripPrefix)  -- | Run a list of actions concurrently. -- runConcurrent :: MonadBaseControl IO m => [m a] -> m () runConcurrent = void . runConcurrently . sequenceA . map Concurrently --- | Reverse of textToString----textFromString :: String -> Text-textFromString = pack- -- | Strip the prefix with a '/' tacked on to the prefix. -- stripPrefix' :: Text -> Text -> Maybe Text stripPrefix' prefix =-  stripPrefix (prefix <\> mempty)---- | </> for Text.----(<\>) :: Text -> Text -> Text-(<\>) = (<>) . (<> "/")+  stripPrefix (prefix -/- mempty)  type MonadBaseControlIO m =   ( MonadBaseControl IO m
src/Network/AWS/Wolf/S3.hs view
@@ -35,7 +35,7 @@ getArtifact file key = do   b    <- view cBucket <$> view ccConf   p    <- view ascPrefix-  gors <- send $ getObject (BucketName b) (ObjectKey (p <\> key))+  gors <- send $ getObject (BucketName b) (ObjectKey (p -/- key))   sinkBody (gors ^. gorsBody) (sinkFile file)  -- | Put object in bucket with key.@@ -45,5 +45,5 @@   b          <- view cBucket <$> view ccConf   p          <- view ascPrefix   (sha, len) <- sourceFile file $$ getZipSink $ (,) <$> ZipSink sinkSHA256 <*> ZipSink lengthE-  void $ send $ putObject (BucketName b) (ObjectKey (p <\> key)) $+  void $ send $ putObject (BucketName b) (ObjectKey (p -/- key)) $     Hashed $ HashedStream sha len $ sourceFile file
− src/Network/AWS/Wolf/Trace.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}---- | Tracing functionality around MonadLogger.----module Network.AWS.Wolf.Trace-  ( newStderrTrace-  , newStdoutTrace-  , nullTrace--  , traceDebug-  , traceInfo-  , traceWarn-  , traceError-  ) where--import           Control.Monad.Logger-import           Data.Aeson-import           Data.Aeson.Encode-import qualified Data.HashMap.Strict      as M-import qualified Data.Text.Lazy           as LT-import           Data.Text.Lazy.Builder-import           Data.Time-import           Data.Version-import           Network.AWS.Wolf.Prelude-import           Network.AWS.Wolf.Types-import           Paths_wolf-import           System.Log.FastLogger---- | Trace out only if gte configured level.----levelTrace :: LogLevel -> LoggerSet -> Trace-levelTrace level ls _loc _source level' s =-  unless (level' < level) $ do-    pushLogStr ls s-    flushLogStr ls---- | New logger to stderr.----newStderrTrace :: MonadIO m => LogLevel -> m Trace-newStderrTrace level =-  liftIO $ levelTrace level <$> newStderrLoggerSet defaultBufSize---- | New logger to stdout.----newStdoutTrace :: MonadIO m => LogLevel -> m Trace-newStdoutTrace level =-  liftIO $ levelTrace level <$> newStdoutLoggerSet defaultBufSize---- | Logger to nowhere.----nullTrace :: Trace-nullTrace _loc _source _level _s =-  return ()---- | Trace out event with preamble and timestamp.----trace :: MonadCtx c m => (Text -> m ()) -> Text -> Pairs -> m ()-trace logN e ps = do-  t <- liftIO getCurrentTime-  let preamble =-        [ "version" .= showVersion version-        , "run"     .= LabelWolf-        , "event"   .= e-        , "time"    .= t-        ]-  p <- view cPreamble-  logN $ LT.toStrict $ toLazyText $ (<> singleton '\n') $-    encodeToTextBuilder $ Object $ M.fromList $ preamble <> p <> ps---- | Debug tracing.----traceDebug :: MonadCtx c m => Text -> Pairs -> m ()-traceDebug = trace logDebugN---- | Info tracing.----traceInfo :: MonadCtx c m => Text -> Pairs -> m ()-traceInfo = trace logInfoN---- | Warn tracing.----traceWarn :: MonadCtx c m => Text -> Pairs -> m ()-traceWarn = trace logWarnN---- | Error tracing.----traceError :: MonadCtx c m => Text -> Pairs -> m ()-traceError = trace logErrorN
src/Network/AWS/Wolf/Types.hs view
@@ -4,9 +4,6 @@   ( module Exports   ) where -import Network.AWS.Wolf.Types.Alias   as Exports import Network.AWS.Wolf.Types.Ctx     as Exports-import Network.AWS.Wolf.Types.Plan    as Exports import Network.AWS.Wolf.Types.Product as Exports import Network.AWS.Wolf.Types.Sum     as Exports-import Network.AWS.Wolf.Types.Trans   as Exports
− src/Network/AWS/Wolf/Types/Alias.hs 
@@ -1,17 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}---- | Various alias types.----module Network.AWS.Wolf.Types.Alias where--import Control.Monad.Logger-import Data.Aeson-import Network.AWS.Wolf.Prelude---- | Pairs----type Pairs = [(Text, Value)]---- | Trace----type Trace = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
src/Network/AWS/Wolf/Types/Ctx.hs view
@@ -6,37 +6,9 @@ -- module Network.AWS.Wolf.Types.Ctx where -import Control.Monad.Catch-import Control.Monad.Logger-import Control.Monad.Reader import Control.Monad.Trans.AWS-import Control.Monad.Trans.Resource-import Network.AWS.Wolf.Lens import Network.AWS.Wolf.Prelude-import Network.AWS.Wolf.Types.Alias import Network.AWS.Wolf.Types.Product---- | Ctx------ Base context, supports tracing.----data Ctx = Ctx-  { _cPreamble :: Pairs-    -- ^ Object to encode on every trace line.-  , _cTrace    :: Trace-    -- ^ Configurable tracing function.-  }--$(makeClassy ''Ctx)--type MonadCtx c m =-  ( MonadBaseControlIO m-  , MonadReader c m-  , MonadLogger m-  , MonadCatch m-  , MonadResource m-  , HasCtx c-  )  -- | ConfCtx --
− src/Network/AWS/Wolf/Types/Plan.hs 
@@ -1,42 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TemplateHaskell   #-}---- | Specifications for plans.----module Network.AWS.Wolf.Types.Plan where--import Data.Aeson.TH-import Network.AWS.Wolf.Aeson-import Network.AWS.Wolf.Prelude---- | Plan Task------ Work task.----data PlanTask = PlanTask-  { _ptName    :: Text-    -- ^ Name of task.-  , _ptVersion :: Text-    -- ^ Version of task.-  , _ptQueue   :: Text-    -- ^ Queue for task.-  , _ptTimeout :: Text-    -- ^ Timeout for task.-  } deriving (Show, Eq)--$(makeLenses ''PlanTask)-$(deriveJSON spinalOptions ''PlanTask)---- | Plan------ Group of tasks.----data Plan = Plan-  { _pStart :: PlanTask-    -- ^ Flow task.-  , _pTasks :: [PlanTask]-    -- ^ Worker tasks.-  } deriving (Show, Eq)--$(makeLenses ''Plan)-$(deriveJSON spinalOptions ''Plan)
src/Network/AWS/Wolf/Types/Product.hs view
@@ -6,7 +6,6 @@ module Network.AWS.Wolf.Types.Product where  import Data.Aeson.TH-import Network.AWS.Wolf.Aeson import Network.AWS.Wolf.Prelude  -- | Conf@@ -38,3 +37,35 @@  $(makeLenses ''Control) $(deriveJSON spinalOptions ''Control)++-- | Plan Task+--+-- Work task.+--+data PlanTask = PlanTask+  { _ptName    :: Text+    -- ^ Name of task.+  , _ptVersion :: Text+    -- ^ Version of task.+  , _ptQueue   :: Text+    -- ^ Queue for task.+  , _ptTimeout :: Text+    -- ^ Timeout for task.+  } deriving (Show, Eq)++$(makeLenses ''PlanTask)+$(deriveJSON spinalOptions ''PlanTask)++-- | Plan+--+-- Group of tasks.+--+data Plan = Plan+  { _pStart :: PlanTask+    -- ^ Flow task.+  , _pTasks :: [PlanTask]+    -- ^ Worker tasks.+  } deriving (Show, Eq)++$(makeLenses ''Plan)+$(deriveJSON spinalOptions ''Plan)
src/Network/AWS/Wolf/Types/Sum.hs view
@@ -6,7 +6,6 @@ module Network.AWS.Wolf.Types.Sum where  import Data.Aeson.TH-import Network.AWS.Wolf.Aeson import Network.AWS.Wolf.Prelude  -- | LabelType
− src/Network/AWS/Wolf/Types/Trans.hs 
@@ -1,47 +0,0 @@-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses      #-}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE TypeFamilies               #-}-{-# LANGUAGE UndecidableInstances       #-}---- | Monad transformer.----module Network.AWS.Wolf.Types.Trans where--import Control.Monad.Base-import Control.Monad.Catch-import Control.Monad.Logger-import Control.Monad.Reader-import Control.Monad.Trans.Control-import Control.Monad.Trans.Resource-import Network.AWS.Wolf.Prelude---- | Monad transformer for reading and logging.----newtype TransT c m a = TransT-  { unTransT :: LoggingT (ReaderT c m) a-    -- ^ LoggingT and ReaderT transformer.-  } deriving (Functor, Applicative, Monad, MonadLogger, MonadReader c, MonadIO, MonadThrow, MonadCatch, MonadMask)--instance MonadBase b m => MonadBase b (TransT c m) where-  liftBase = liftBaseDefault--instance MonadBaseControl b m => MonadBaseControl b (TransT c m) where-    type StM (TransT c m) a = ComposeSt (TransT c) m a-    liftBaseWith = defaultLiftBaseWith-    restoreM = defaultRestoreM--instance MonadTransControl (TransT c) where-  type StT (TransT c) a = StT (ReaderT c) a-  liftWith f = TransT $-    liftWith $ \g ->-      liftWith $ \h ->-        f (h . g . unTransT)-  restoreT = TransT . restoreT . restoreT--instance MonadTrans (TransT c) where-  lift = TransT . lift . lift--instance MonadResource m => MonadResource (TransT c m) where-  liftResourceT = lift . liftResourceT
wolf.cabal view
@@ -1,5 +1,5 @@ name:                wolf-version:             0.3.0+version:             0.3.1 synopsis:            Amazon Simple Workflow Service Wrapper. homepage:            https://github.com/swift-nav/wolf license:             MIT@@ -30,22 +30,16 @@                      , Network.AWS.Flow.Types                      , Network.AWS.Flow.Uid                      , Network.AWS.Wolf.Act-                     , Network.AWS.Wolf.Aeson                      , Network.AWS.Wolf.Ctx                      , Network.AWS.Wolf.Decide                      , Network.AWS.Wolf.File-                     , Network.AWS.Wolf.Lens                      , Network.AWS.Wolf.Prelude                      , Network.AWS.Wolf.S3                      , Network.AWS.Wolf.SWF-                     , Network.AWS.Wolf.Trace                      , Network.AWS.Wolf.Types-                     , Network.AWS.Wolf.Types.Alias                      , Network.AWS.Wolf.Types.Ctx-                     , Network.AWS.Wolf.Types.Plan                      , Network.AWS.Wolf.Types.Product                      , Network.AWS.Wolf.Types.Sum-                     , Network.AWS.Wolf.Types.Trans                      , Paths_wolf   default-language:    Haskell2010   hs-source-dirs:      src@@ -76,6 +70,7 @@                      , mtl                      , mtl-compat                      , optparse-applicative+                     , preamble                      , process                      , regex-applicative                      , regex-compat