diff --git a/amazonka/HaskellWorks/Polysemy/Amazonka.hs b/amazonka/HaskellWorks/Polysemy/Amazonka.hs --- a/amazonka/HaskellWorks/Polysemy/Amazonka.hs +++ b/amazonka/HaskellWorks/Polysemy/Amazonka.hs @@ -5,7 +5,8 @@ {- HLINT ignore "Use let" -} module HaskellWorks.Polysemy.Amazonka - ( AwsLogEntry(..), + ( AwsError, + AwsLogEntry(..), runReaderAwsEnvDiscover, sendAws, interpretDataLogAwsLogEntryToLog, @@ -30,6 +31,7 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT import qualified GHC.Stack as GHC +import HaskellWorks.Polysemy.Amazonka.Errors import HaskellWorks.Polysemy.Control.Concurrent.STM.TVar import HaskellWorks.Polysemy.Log import HaskellWorks.Polysemy.System.Environment @@ -85,12 +87,25 @@ runReader awsEnv f +sendAwsInternal :: () + => AWS.AWSRequest a + => Member (Embed m) r + => Member (Error AwsError) r + => MonadIO m + => Typeable (AWS.AWSResponse a) + => Typeable a + => AWS.Env + -> a + -> Sem r (AWS.AWSResponse a) +sendAwsInternal envAws req = + fromEither =<< embed (liftIO $ runResourceT $ AWS.sendEither envAws req) + sendAws :: forall a r m. () => HasCallStack => AWS.AWSRequest a => Member (DataLog AwsLogEntry) r => Member (Embed m) r - => Member (Error AWS.Error) r + => Member (Error AwsError) r => Member (Reader AWS.Env) r => Member Resource r => MonadIO m @@ -107,7 +122,7 @@ let envAws1 = envAws0 { AWS.logger = logger } - (fromEither =<< embed (liftIO $ runResourceT $ AWS.sendEither envAws1 req)) + sendAwsInternal envAws1 req & do flip finally do entries <- L.reverse <$> readTVarIO tStack forM_ entries dataLog diff --git a/amazonka/HaskellWorks/Polysemy/Amazonka/Errors.hs b/amazonka/HaskellWorks/Polysemy/Amazonka/Errors.hs new file mode 100644 --- /dev/null +++ b/amazonka/HaskellWorks/Polysemy/Amazonka/Errors.hs @@ -0,0 +1,5 @@ +module HaskellWorks.Polysemy.Amazonka.Errors ( + AwsError, +) where + +import HaskellWorks.Polysemy.Amazonka.Errors.All diff --git a/amazonka/HaskellWorks/Polysemy/Amazonka/Errors/All.hs b/amazonka/HaskellWorks/Polysemy/Amazonka/Errors/All.hs new file mode 100644 --- /dev/null +++ b/amazonka/HaskellWorks/Polysemy/Amazonka/Errors/All.hs @@ -0,0 +1,5 @@ +module HaskellWorks.Polysemy.Amazonka.Errors.All ( + AwsError, +) where + +import HaskellWorks.Polysemy.Amazonka.Errors.AwsError diff --git a/amazonka/HaskellWorks/Polysemy/Amazonka/Errors/AwsError.hs b/amazonka/HaskellWorks/Polysemy/Amazonka/Errors/AwsError.hs new file mode 100644 --- /dev/null +++ b/amazonka/HaskellWorks/Polysemy/Amazonka/Errors/AwsError.hs @@ -0,0 +1,7 @@ +module HaskellWorks.Polysemy.Amazonka.Errors.AwsError ( + AwsError, +) where + +import qualified Amazonka as AWS + +type AwsError = AWS.Error diff --git a/core/HaskellWorks/Polysemy/Data/Aeson.hs b/core/HaskellWorks/Polysemy/Data/Aeson.hs --- a/core/HaskellWorks/Polysemy/Data/Aeson.hs +++ b/core/HaskellWorks/Polysemy/Data/Aeson.hs @@ -1,25 +1,21 @@ module HaskellWorks.Polysemy.Data.Aeson - ( AesonDecodeError(..), - aesonDecode, + ( aesonDecode, ) where -import qualified Data.Aeson as Aeson -import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS +import qualified Data.Aeson as Aeson +import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS import HaskellWorks.Polysemy.Prelude import Polysemy import Polysemy.Error -import Data.Aeson (FromJSON) - -newtype AesonDecodeError - = AesonDecodeError String - deriving (Show) +import Data.Aeson (FromJSON) +import HaskellWorks.Polysemy.Error.Types.JsonDecodeError (JsonDecodeError (JsonDecodeError)) aesonDecode :: forall a r. () - => Member (Error AesonDecodeError) r + => Member (Error JsonDecodeError) r => FromJSON a => LBS.ByteString -> Sem r a aesonDecode bs = fromEither (Aeson.eitherDecode bs) - & mapError AesonDecodeError + & mapError JsonDecodeError diff --git a/core/HaskellWorks/Polysemy/Error/Types.hs b/core/HaskellWorks/Polysemy/Error/Types.hs --- a/core/HaskellWorks/Polysemy/Error/Types.hs +++ b/core/HaskellWorks/Polysemy/Error/Types.hs @@ -1,5 +1,9 @@ module HaskellWorks.Polysemy.Error.Types - ( module HaskellWorks.Error.Types + ( module HaskellWorks.Error.Types, + + JsonDecodeError(JsonDecodeError), + YamlDecodeError(YamlDecodeError), ) where import HaskellWorks.Error.Types +import HaskellWorks.Polysemy.Error.Types.All diff --git a/core/HaskellWorks/Polysemy/Error/Types/All.hs b/core/HaskellWorks/Polysemy/Error/Types/All.hs new file mode 100644 --- /dev/null +++ b/core/HaskellWorks/Polysemy/Error/Types/All.hs @@ -0,0 +1,7 @@ +module HaskellWorks.Polysemy.Error.Types.All + ( JsonDecodeError(..), + YamlDecodeError(..), + ) where + +import HaskellWorks.Polysemy.Error.Types.JsonDecodeError +import HaskellWorks.Polysemy.Error.Types.YamlDecodeError diff --git a/core/HaskellWorks/Polysemy/Error/Types/JsonDecodeError.hs b/core/HaskellWorks/Polysemy/Error/Types/JsonDecodeError.hs new file mode 100644 --- /dev/null +++ b/core/HaskellWorks/Polysemy/Error/Types/JsonDecodeError.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module HaskellWorks.Polysemy.Error.Types.JsonDecodeError + ( JsonDecodeError(..) + ) where + +import HaskellWorks.Prelude + +newtype JsonDecodeError = + JsonDecodeError + { message :: String + } + deriving (Eq, Generic, Show) diff --git a/core/HaskellWorks/Polysemy/Error/Types/YamlDecodeError.hs b/core/HaskellWorks/Polysemy/Error/Types/YamlDecodeError.hs new file mode 100644 --- /dev/null +++ b/core/HaskellWorks/Polysemy/Error/Types/YamlDecodeError.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} + +module HaskellWorks.Polysemy.Error.Types.YamlDecodeError + ( YamlDecodeError(..) + ) where + +import HaskellWorks.Prelude + +newtype YamlDecodeError = + YamlDecodeError + { message :: String + } + deriving (Eq, Generic, Show) diff --git a/core/HaskellWorks/Polysemy/File.hs b/core/HaskellWorks/Polysemy/File.hs --- a/core/HaskellWorks/Polysemy/File.hs +++ b/core/HaskellWorks/Polysemy/File.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module HaskellWorks.Polysemy.File ( JsonDecodeError(..) , YamlDecodeError(..) @@ -8,22 +6,17 @@ ) where import Data.Aeson -import qualified Data.Aeson as J -import qualified Data.Yaml as Y -import GHC.Generics -import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS -import qualified HaskellWorks.Polysemy.Data.Text as T +import qualified Data.Aeson as J +import qualified Data.Yaml as Y +import qualified HaskellWorks.Polysemy.Data.ByteString.Lazy as LBS +import qualified HaskellWorks.Polysemy.Data.Text as T import HaskellWorks.Polysemy.Error +import HaskellWorks.Polysemy.Error.Types.JsonDecodeError +import HaskellWorks.Polysemy.Error.Types.YamlDecodeError import HaskellWorks.Polysemy.Prelude import Polysemy import Polysemy.Error import Polysemy.Log - -newtype JsonDecodeError = JsonDecodeError { message :: String } - deriving (Eq, Generic, Show) - -newtype YamlDecodeError = YamlDecodeError { message :: String } - deriving (Eq, Generic, Show) -- | Read the 'filePath' file as JSON. Use @readJsonFile \@'Value'@ to decode into 'Value'. readJsonFile :: forall a r. () diff --git a/hw-polysemy.cabal b/hw-polysemy.cabal --- a/hw-polysemy.cabal +++ b/hw-polysemy.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: hw-polysemy -version: 0.3.0.0 +version: 0.3.0.1 synopsis: Opinionated polysemy library description: Opinionated polysemy library. license: Apache-2.0 @@ -35,7 +35,8 @@ common ghc-prim { build-depends: ghc-prim < 0.12 } common hedgehog { build-depends: hedgehog < 1.6 } common http-conduit { build-depends: http-conduit >= 2.3 && < 2.4 } -common hw-prelude { build-depends: hw-prelude >= 0.0.0.1 && < 0.1 } +common hw-prelude { build-depends: hw-prelude >= 0.0.0.3 && < 0.1 } +common microlens { build-depends: microlens < 5 } common lens { build-depends: lens < 5.4 } common mtl { build-depends: mtl < 2.4 } common network { build-depends: network < 3.3 } @@ -101,24 +102,25 @@ async, bytestring, contravariant, - exceptions, directory, + exceptions, filepath, generic-lens, ghc-prim, hedgehog, hw-prelude, lens, + microlens, mtl, network, - polysemy, polysemy-log, polysemy-time, + polysemy, process, resourcet, stm, - text, temporary, + text, time, ulid, unliftio, @@ -144,6 +146,9 @@ HaskellWorks.Polysemy.Data.ULID HaskellWorks.Polysemy.Error HaskellWorks.Polysemy.Error.Types + HaskellWorks.Polysemy.Error.Types.All + HaskellWorks.Polysemy.Error.Types.JsonDecodeError + HaskellWorks.Polysemy.Error.Types.YamlDecodeError HaskellWorks.Polysemy.Except HaskellWorks.Polysemy.File HaskellWorks.Polysemy.FilePath @@ -211,6 +216,7 @@ library amazonka import: base, project-config, + aeson, amazonka, binary, generic-lens, @@ -224,6 +230,9 @@ stm, visibility: public exposed-modules: HaskellWorks.Polysemy.Amazonka + HaskellWorks.Polysemy.Amazonka.Errors + HaskellWorks.Polysemy.Amazonka.Errors.All + HaskellWorks.Polysemy.Amazonka.Errors.AwsError hs-source-dirs: amazonka default-language: Haskell2010