hw-polysemy 0.3.0.2 → 0.3.1.0

raw patch · 28 files changed

+109/−94 lines, 28 filesdep ~hw-preludePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hw-prelude

API changes (from Hackage documentation)

Files

• amazonka/HaskellWorks/Polysemy/Amazonka.hs +3/−3
• amazonka/HaskellWorks/Polysemy/Amazonka/Errors.hs +1/−1
• amazonka/HaskellWorks/Polysemy/Amazonka/Errors/All.hs +0/−5
• core/HaskellWorks/Polysemy/Cabal.hs +4/−4
• core/HaskellWorks/Polysemy/Data/Aeson.hs +2/−2
• core/HaskellWorks/Polysemy/Error.hs +9/−0
• core/HaskellWorks/Polysemy/Error/Types.hs +4/−3
• core/HaskellWorks/Polysemy/Error/Types/All.hs +0/−7
• core/HaskellWorks/Polysemy/Error/Types/JsonDecodeError.hs +33/−2
• core/HaskellWorks/Polysemy/Error/Types/YamlDecodeError.hs +13/−2
• core/HaskellWorks/Polysemy/Except.hs +0/−1
• core/HaskellWorks/Polysemy/File.hs +2/−3
• core/HaskellWorks/Polysemy/Log.hs +0/−8
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Assert.hs +13/−5
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog.hs +0/−1
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Effect/Hedgehog/Internal.hs +0/−3
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Golden.hs +0/−2
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Jot.hs +0/−4
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Process.hs +4/−4
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Time.hs +0/−3
• hedgehog/HaskellWorks/Polysemy/Hedgehog/Workspace/Types.hs +0/−2
• hw-polysemy.cabal +19/−4
• test/HaskellWorks/Polysemy/HedgehogSpec.hs +0/−4
• test/HaskellWorks/Polysemy/TestContainers/LocalStackSpec.hs +0/−3
• test/Test/Polysemy/Env.hs +0/−9
• testcontainers-localstack/HaskellWorks/Polysemy/Amazonka/LocalStack.hs +2/−2
• testcontainers-localstack/HaskellWorks/TestContainers/LocalStack.hs +0/−4
• testcontainers-localstack/HaskellWorks/TestContainers/LocalStack/Types.hs +0/−3

@@ -154,9 +154,9 @@ interpretDataLogAwsLogEntryLocalToLogWith mapSeverity context =   interpretH \case     Log.DataLog logEntry -> do-      let cs = logEntry ^. the @"callStack"-      let severity = mapSeverity (logEntry ^. the @"logLevel")-      let text = LT.toStrict (LT.decodeUtf8 (B.toLazyByteString (logEntry ^. the @"builder")))+      let cs = logEntry.callStack+      let severity = mapSeverity logEntry.logLevel+      let text = LT.toStrict (LT.decodeUtf8 (B.toLazyByteString logEntry.builder))       liftT (logCs cs severity text)     Log.Local f ma ->       raise . interpretDataLogAwsLogEntryLocalToLogWith mapSeverity (f . context) =<< runT ma

@@ -2,4 +2,4 @@     AwsError, ) where -import           HaskellWorks.Polysemy.Amazonka.Errors.All+import           HaskellWorks.Polysemy.Amazonka.Errors.AwsError

@@ -1,5 +0,0 @@-module HaskellWorks.Polysemy.Amazonka.Errors.All (-    AwsError,-) where--import           HaskellWorks.Polysemy.Amazonka.Errors.AwsError

@@ -72,14 +72,14 @@   planJsonFile <- getPlanJsonFile   contents <- LBS.readFile planJsonFile -  case eitherDecode contents of-    Right plan -> case L.filter matching (plan & installPlan) of-      (component:_) -> case component & binFile of+  case eitherDecode @Plan contents of+    Right plan -> case L.filter matching plan.installPlan of+      (component:_) -> case component.binFile of         Just bin -> return $ addExeSuffix (T.unpack bin)         Nothing  -> throw $ GenericError $ "Missing bin-file in " <> tshow component       [] -> throw $ GenericError $ "Cannot find exe " <> tshow pkg <> " in plan"     Left msg -> throw $ GenericError $ "Cannot decode plan: " <> T.pack msg   where matching :: Component -> Bool-        matching component = case componentName component of+        matching component = case component.componentName of           Just name -> name == "exe:" <> T.pack pkg           Nothing   -> False

@@ -9,7 +9,7 @@ import           Polysemy.Error  import           Data.Aeson                                        (FromJSON)-import           HaskellWorks.Polysemy.Error.Types.JsonDecodeError (JsonDecodeError (JsonDecodeError))+import           HaskellWorks.Polysemy.Error.Types.JsonDecodeError  aesonDecode :: forall a r. ()   => Member (Error JsonDecodeError) r@@ -18,4 +18,4 @@   -> Sem r a aesonDecode bs =   fromEither (Aeson.eitherDecode bs)-    & mapError JsonDecodeError+    & mapError newJsonDecodeError

@@ -2,6 +2,7 @@   ( module HaskellWorks.Error,     trap,     trap_,+    runErrorMap,     embedRunExceptT,     embedThrowExceptT,   ) where@@ -29,6 +30,14 @@   -> Sem r a trap_ h =   trap (const h)++-- | Run an 'Error' effect and map the error value to a different type.+runErrorMap :: ()+  => (e -> d)+  -> Sem (Error e : r) a+  -> Sem r (Either d a)+runErrorMap f =+  fmap (first f) . runError  embedRunExceptT :: forall e a r m. ()   => Member (Embed m) r

@@ -1,9 +1,10 @@ module HaskellWorks.Polysemy.Error.Types   ( module HaskellWorks.Error.Types, -    JsonDecodeError(JsonDecodeError),-    YamlDecodeError(YamlDecodeError),+    JsonDecodeError(..),+    YamlDecodeError(..),   ) where  import           HaskellWorks.Error.Types-import           HaskellWorks.Polysemy.Error.Types.All+import           HaskellWorks.Polysemy.Error.Types.JsonDecodeError+import           HaskellWorks.Polysemy.Error.Types.YamlDecodeError

@@ -1,7 +0,0 @@-module HaskellWorks.Polysemy.Error.Types.All-  ( JsonDecodeError(..),-    YamlDecodeError(..),-  ) where--import           HaskellWorks.Polysemy.Error.Types.JsonDecodeError-import           HaskellWorks.Polysemy.Error.Types.YamlDecodeError

@@ -1,14 +1,45 @@+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NoFieldSelectors      #-}+{-# LANGUAGE OverloadedRecordDot   #-}  module HaskellWorks.Polysemy.Error.Types.JsonDecodeError   ( JsonDecodeError(..)+  , newJsonDecodeError   ) where ++import           Data.Aeson           (ToJSON (..), Value, (.=))+import qualified Data.Aeson           as J+import           GHC.Generics+ import           HaskellWorks.Prelude+import           HaskellWorks.ToText -newtype JsonDecodeError =+data JsonDecodeError =   JsonDecodeError-  { message :: String+  { message    :: Text+  , bytestring :: Maybe ByteString+  , text       :: Maybe Text+  , json       :: Maybe Value   }   deriving (Eq, Generic, Show)++newJsonDecodeError :: ToText a => a -> JsonDecodeError+newJsonDecodeError message =+  JsonDecodeError+    { message    = toText message+    , bytestring = Nothing+    , text       = Nothing+    , json       = Nothing+    }++instance ToJSON JsonDecodeError where+  toJSON e =+    J.object+        [ "error" .= id @Text "JsonDecodeError"+        , "message" .= e.message+        , "text" .= e.text+        , "json" .= e.json+        ]

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds             #-} {-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE DuplicateRecordFields #-} @@ -5,10 +6,20 @@   ( YamlDecodeError(..)   ) where -import           HaskellWorks.Prelude +import           Data.Aeson           (ToJSON (..), (.=))+import qualified Data.Aeson           as J+import           GHC.Generics+import           HaskellWorks.Prelude newtype YamlDecodeError =   YamlDecodeError-  { message :: String+  { message :: Text   }   deriving (Eq, Generic, Show)++instance ToJSON YamlDecodeError where+  toJSON e =+        J.object+            [ "error" .= id @Text "YamlDecodeError"+            , "message" .= e.message+            ]

@@ -1,4 +1,3 @@-{-# LANGUAGE GADTs           #-} {-# LANGUAGE TemplateHaskell #-}  -- | Description: The 'Except' effect, providing catch and throw functionality over the final

@@ -32,8 +32,7 @@   info $ "Reading JSON file: " <> T.pack filePath   contents <- LBS.readFile filePath   J.eitherDecode contents-    & onLeft (throw . JsonDecodeError)-+    & onLeft (throw . newJsonDecodeError)  -- | Read the 'filePath' file as YAML. readYamlFile :: forall a r. ()@@ -50,4 +49,4 @@   info $ "Reading YAML file: " <> T.pack filePath   contents <- LBS.toStrict <$> LBS.readFile filePath   Y.decodeEither' contents-    & onLeft (throw . YamlDecodeError . Y.prettyPrintParseException)+    & onLeft (throw . YamlDecodeError . T.pack . Y.prettyPrintParseException)

@@ -1,11 +1,3 @@-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE PolyKinds           #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}- {- HLINT ignore "Use let" -}  module HaskellWorks.Polysemy.Log

@@ -21,6 +21,7 @@     evalIO,     failure,     failMessage,+    failMessageText,     byDeadlineIO,     byDeadlineM,     byDurationIO,@@ -44,11 +45,9 @@   import qualified Control.Concurrent                             as IO-import           Control.Lens                                   ((^.)) import           Data.Aeson                                     (ToJSON, Value) import qualified Data.Aeson                                     as J import qualified Data.Aeson.Encode.Pretty                       as J-import           Data.Generics.Product.Any import qualified Data.List                                      as L import qualified Data.Text                                      as T import qualified Data.Text.Encoding                             as T@@ -123,6 +122,15 @@ failMessage cs =   withFrozenCallStack $ failWithCustom cs Nothing +failMessageText :: forall a r. ()+  => Member Hedgehog r+  => HasCallStack+  => GHC.CallStack+  -> Text+  -> Sem r a+failMessageText cs =+  failMessage cs . T.unpack+ leftFailM :: forall e a r. ()   => Member Hedgehog r   => Show e@@ -327,7 +335,7 @@ assertIsJsonFile_ fp = withFrozenCallStack $ do   void (readJsonFile @Value fp)     & trap @IOException (failMessage GHC.callStack . show)-    & trap @JsonDecodeError (\e -> failMessage GHC.callStack (e ^. the @"message"))+    & trap @JsonDecodeError (\e -> failMessageText GHC.callStack e.message)  -- | Assert the 'filePath' can be parsed as YAML. assertIsYamlFile :: forall r. ()@@ -340,8 +348,8 @@ assertIsYamlFile fp = withFrozenCallStack $ do   void (readYamlFile @Value fp)     & trap @IOException (failMessage GHC.callStack . show)-    & trap @JsonDecodeError (\e -> failMessage GHC.callStack (e ^. the @"message"))-    & trap @YamlDecodeError (\e -> failMessage GHC.callStack (e ^. the @"message"))+    & trap @JsonDecodeError (\e -> failMessageText GHC.callStack e.message)+    & trap @YamlDecodeError (\e -> failMessageText GHC.callStack e.message)  -- | Asserts that the given file exists. assertFileExists :: forall r. ()

@@ -1,4 +1,3 @@-{-# LANGUAGE GADTs           #-} {-# LANGUAGE TemplateHaskell #-}  module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog

@@ -1,6 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving         #-}- module HaskellWorks.Polysemy.Hedgehog.Effect.Hedgehog.Internal   ( MonadAssertion(..),     failWithCustom,

@@ -1,5 +1,3 @@-{-# LANGUAGE MultiWayIf #-}- module HaskellWorks.Polysemy.Hedgehog.Golden   ( diffVsGoldenFile,     diffFileVsGoldenFile,

@@ -1,7 +1,3 @@-{-# LANGUAGE BangPatterns        #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE ScopedTypeVariables #-}- module HaskellWorks.Polysemy.Hedgehog.Jot   ( jotShow,     jotShow_,

@@ -183,8 +183,8 @@   -> Sem r (ExitCode, String, String) -- ^ exit code, stdout, stderr exec execConfig bin arguments = withFrozenCallStack $ do   let cp = (proc bin arguments)-        { env = getLast $ execConfigEnv execConfig-        , cwd = getLast $ execConfigCwd execConfig+        { env = getLast execConfig.execConfigEnv+        , cwd = getLast execConfig.execConfigCwd         }   jot_ . ( "━━━━ command ━━━━\n" <>) $ bin <> " " <> L.unwords (argQuote <$> arguments)   readCreateProcessWithExitCode cp ""@@ -271,8 +271,8 @@ procFlex' execConfig pkg binaryEnv arguments = withFrozenCallStack $ do   bin <- binFlex pkg binaryEnv   return (proc bin arguments)-    { env = getLast $ execConfigEnv execConfig-    , cwd = getLast $ execConfigCwd execConfig+    { env = getLast execConfig.execConfigEnv+    , cwd = getLast execConfig.execConfigCwd     -- this allows sending signals to the created processes, without killing the test-suite process     , create_group = True     }

@@ -1,6 +1,3 @@-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE TypeApplications   #-}- module HaskellWorks.Polysemy.Hedgehog.Time (     genPOSIXTime, ) where

@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}- module HaskellWorks.Polysemy.Hedgehog.Workspace.Types   ( PackagePath(..),     ProjectRoot(..),

@@ -1,6 +1,6 @@ cabal-version:          3.4 name:                   hw-polysemy-version:                0.3.0.2+version:                0.3.1.0 synopsis:               Opinionated polysemy library description:            Opinionated polysemy library. license:                Apache-2.0@@ -35,7 +35,7 @@ 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.3    && < 0.1    }+common hw-prelude                 { build-depends: hw-prelude                 >= 0.0.1.0    && < 0.1    } common microlens                  { build-depends: microlens                                   < 5      } common lens                       { build-depends: lens                                        < 5.4    } common mtl                        { build-depends: mtl                                         < 2.4    }@@ -79,18 +79,35 @@   import:               polysemy,                         polysemy-plugin,   default-extensions:   BlockArguments+                        BangPatterns                         DataKinds                         DeriveGeneric+                        DerivingStrategies+                        DisambiguateRecordFields                         DuplicateRecordFields                         FlexibleContexts                         FlexibleInstances+                        GADTs+                        GeneralizedNewtypeDeriving                         LambdaCase+                        MultiWayIf+                        NamedFieldPuns+                        NoFieldSelectors                         NoImplicitPrelude+                        NumericUnderscores+                        OverloadedRecordDot                         OverloadedStrings+                        PatternSynonyms+                        PolyKinds                         RankNTypes+                        RecordWildCards                         ScopedTypeVariables+                        StandaloneDeriving+                        StrictData                         TypeApplications+                        TypeFamilies                         TypeOperators+                        TypeSynonymInstances   ghc-options:          -Wall                         -fplugin=Polysemy.Plugin   if flag(werror)@@ -146,7 +163,6 @@                         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@@ -233,7 +249,6 @@   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

@@ -1,7 +1,3 @@-{-# LANGUAGE DataKinds        #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}- module HaskellWorks.Polysemy.HedgehogSpec   ( hprop_example_property,     hprop_example_test,

@@ -1,6 +1,3 @@-{-# LANGUAGE GADTs             #-}-{-# LANGUAGE OverloadedStrings #-}- {- HLINT ignore "Use let" -}  module HaskellWorks.Polysemy.TestContainers.LocalStackSpec

@@ -1,12 +1,3 @@-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE PolyKinds           #-}-{-# LANGUAGE RankNTypes          #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators       #-}- {- HLINT ignore "Use let" -}  module Test.Polysemy.Env

@@ -8,7 +8,7 @@  import qualified Amazonka                                     as AWS import qualified Amazonka.Auth                                as AWS-import           Control.Lens                                 ((%~), (.~), (^.))+import           Control.Lens                                 ((%~), (.~)) import qualified Data.Aeson                                   as J import           Data.Generics.Product.Any import           HaskellWorks.Prelude@@ -38,7 +38,7 @@   awsEnv <- pure $     credEnv       & the @"logger" .~ logger'-      & the @"overrides" %~ (. AWS.setEndpoint False "localhost" (ep ^. the @"port"))+      & the @"overrides" %~ (. AWS.setEndpoint False "localhost" ep.port)    runReader awsEnv f 

@@ -1,7 +1,3 @@-{-# LANGUAGE GADTs              #-}-{-# LANGUAGE NumericUnderscores #-}-{-# LANGUAGE OverloadedStrings  #-}- {- HLINT ignore "Use camelCase" -}  module HaskellWorks.TestContainers.LocalStack (

@@ -1,6 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GADTs         #-}- module HaskellWorks.TestContainers.LocalStack.Types   ( LocalStackEndpoint(..)   ) where