freckle-app 1.20.0.1 → 1.20.1.0
raw patch · 9 files changed
+54/−533 lines, 9 filesdep +HUnitdep +freckle-exceptiondep +freckle-preludedep −annotated-exceptiondep −hashabledep −monad-logger-aeson
Dependencies added: HUnit, freckle-exception, freckle-prelude
Dependencies removed: annotated-exception, hashable, monad-logger-aeson, safe
Files
- CHANGELOG.md +13/−1
- freckle-app.cabal +10/−10
- library/Freckle/App/Exception.hs +0/−53
- library/Freckle/App/Exception/MonadThrow.hs +0/−131
- library/Freckle/App/Exception/MonadUnliftIO.hs +0/−133
- library/Freckle/App/Exception/Types.hs +0/−15
- library/Freckle/App/Prelude.hs +0/−185
- library/Freckle/App/Test/Hspec/AnnotatedException.hs +22/−0
- package.yaml +9/−5
CHANGELOG.md view
@@ -1,4 +1,16 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.0.1...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.1.0...main)++## [v1.20.1.0](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.0.1...freckle-app-v1.20.1.0)++Modules moving between packages:++- `Freckle.App.Prelude` has moved to the `freckle-prelude` package+- `Freckle.App.Exception(.*)` has moved to the `freckle-exception` package+- All moved modules are re-exported from `freckle-app`.++- Added `Freckle.App.Test.Hspec.AnnotatedException` (`unwrapAnnotatedHUnitFailure`).+ It is recommended that all hspec test suites for packages that use `freckle-prelude`+ add this spec hook. ## [v1.20.0.1](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.0.0...freckle-app-v1.20.0.1)
freckle-app.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.22 name: freckle-app-version: 1.20.0.1+version: 1.20.1.0 license: MIT license-file: LICENSE maintainer: Freckle Education@@ -30,21 +30,17 @@ Freckle.App.Csv Freckle.App.Database Freckle.App.Ecs- Freckle.App.Exception- Freckle.App.Exception.MonadThrow- Freckle.App.Exception.MonadUnliftIO- Freckle.App.Exception.Types Freckle.App.Faktory.ProducerPool Freckle.App.Ghci Freckle.App.GlobalCache Freckle.App.Json.Empty- Freckle.App.Prelude Freckle.App.Random Freckle.App.Scientist Freckle.App.Stats Freckle.App.Stats.Rts Freckle.App.Test Freckle.App.Test.DocTest+ Freckle.App.Test.Hspec.AnnotatedException Freckle.App.Test.Hspec.Runner Freckle.App.Test.Properties.JSON Freckle.App.Test.Properties.PathPiece@@ -69,6 +65,11 @@ Freckle.App.Http.Paginate, Freckle.App.Http.Retry, Freckle.App.HttpSpec,+ Freckle.App.Prelude,+ Freckle.App.Exception,+ Freckle.App.Exception.MonadThrow,+ Freckle.App.Exception.MonadUnliftIO,+ Freckle.App.Exception.Types, Freckle.App.Test.Http, Freckle.App.Test.Http.MatchRequest @@ -92,10 +93,10 @@ Blammo >=2.1.0.0, Blammo-wai >=0.0.0.2, Glob >=0.10.2,+ HUnit >=1.6.2.0, MonadRandom >=0.5.3, QuickCheck >=2.14.3, aeson >=2.0.3.0,- annotated-exception >=0.2.0.4, autodocodec >=0.2.0.3, autodocodec-openapi3 >=0.2.1.1, base >=4.16.4.0 && <5,@@ -115,9 +116,10 @@ extra >=1.7.13, faktory >=1.1.2.4, freckle-env >=0.0.1.1,+ freckle-exception >=0.0.0.0, freckle-http >=0.0.0.0, freckle-otel >=0.0.0.2,- hashable >=1.4.2.0,+ freckle-prelude >=0.0.1.1, hs-opentelemetry-api >=0.1.0.0, hs-opentelemetry-instrumentation-persistent >=0.1.0.0, hs-opentelemetry-instrumentation-wai >=0.1.0.0,@@ -131,7 +133,6 @@ immortal >=0.3, lens >=5.1.1, monad-control >=1.0.3.1,- monad-logger-aeson >=0.4.0.4, monad-validate >=1.3.0.0, mtl >=2.2.2, nonempty-containers >=0.3.4.4,@@ -143,7 +144,6 @@ primitive >=0.7.3.0, resource-pool >=0.4.0.0, resourcet >=1.2.6,- safe >=0.3.19, scientist >=0.0.0.0, semigroupoids >=5.3.7, template-haskell >=2.18.0.0,
− library/Freckle/App/Exception.hs
@@ -1,53 +0,0 @@-module Freckle.App.Exception- ( -- * Re-export of our current preferred implementation module-- -- | Currently 'MonadUnliftIO'-based- module Freckle.App.Exception.MonadUnliftIO-- -- * Helpers that are agnostic to either implementation- , annotatedExceptionMessage- , annotatedExceptionMessageFrom- ) where--import Prelude--import Control.Exception.Annotated (annotatedExceptionCallStack)-import Control.Exception.Annotated qualified as AnnotatedException-import Control.Monad.Logger.Aeson (Message (..), (.=))-import Data.Aeson (object)-import Freckle.App.Exception.MonadUnliftIO-import GHC.Exception (prettyCallStack)---- | Construct a log 'Message' for any @'AnnotatedException' exception@------ Produces a log message that works with Datadog /Standard Attributes/.------ <https://docs.datadoghq.com/standard-attributes/?search=error.>------ @--- Exception--- error.message: {displayException on underlying exception}--- error.stack: {prettyCallStack from the annotation, if available}--- @------ You are expected to call this with a @TypeApplication@, for example:------ @--- 'catch' myAction $ 'logError' . 'annotatedExceptionMessage' @MyException--- @-annotatedExceptionMessage :: Exception ex => AnnotatedException ex -> Message-annotatedExceptionMessage = annotatedExceptionMessageFrom $ const "Exception"---- | Like 'annotatedExceptionMessage', but use the supplied function to--- construct an initial 'Message' that it will augment.-annotatedExceptionMessageFrom- :: Exception ex => (ex -> Message) -> AnnotatedException ex -> Message-annotatedExceptionMessageFrom f ann = case f ex of- msg :# series -> msg :# series <> ["error" .= errorObject]- where- ex = AnnotatedException.exception ann- errorObject =- object- [ "message" .= displayException ex- , "stack" .= (prettyCallStack <$> annotatedExceptionCallStack ann)- ]
− library/Freckle/App/Exception/MonadThrow.hs
@@ -1,131 +0,0 @@-module Freckle.App.Exception.MonadThrow- ( throwM- , throwString- , fromJustNoteM- , impossible- , catch- , catchJust- , catches- , try- , tryJust- , withException- , checkpoint- , checkpointMany- , checkpointCallStack-- -- * Miscellany- , MonadThrow- , MonadCatch- , MonadMask- , module Freckle.App.Exception.Types- ) where--import Freckle.App.Exception.Types--import Control.Applicative (pure)-import Control.Exception.Annotated (checkpoint, checkpointMany)-import Control.Monad (void)-import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)-import Data.Either (Either (..))-import Data.Function (($), (.))-import Data.Functor (fmap, (<$>))-import Data.Maybe (Maybe, maybe)-import Data.String (String)-import GHC.IO.Exception (userError)-import GHC.Stack (withFrozenCallStack)--import Control.Exception.Annotated qualified as Annotated-import Control.Monad.Catch qualified---- Throws an exception, wrapped in 'AnnotatedException' which includes a call stack-throwM :: forall e m a. (Exception e, MonadThrow m, HasCallStack) => e -> m a-throwM e = withFrozenCallStack $ Annotated.throw e--throwString :: forall m a. (MonadThrow m, HasCallStack) => String -> m a-throwString s = withFrozenCallStack $ throwM $ userError s--fromJustNoteM- :: forall m a. (MonadThrow m, HasCallStack) => String -> Maybe a -> m a-fromJustNoteM err = withFrozenCallStack $ maybe (throwString err) pure--impossible :: forall m a. (MonadThrow m, HasCallStack) => m a-impossible = withFrozenCallStack $ throwString "Impossible"--catch- :: forall e m a- . (Exception e, MonadCatch m, HasCallStack)- => m a- -> (e -> m a)- -> m a-catch action handler = withFrozenCallStack $ Annotated.catch action handler--catchJust- :: forall e b m a- . (Exception e, MonadCatch m, HasCallStack)- => (e -> Maybe b)- -> m a- -> (b -> m a)- -> m a-catchJust test action handler =- withFrozenCallStack $ Annotated.catch action $ \e ->- maybe (Control.Monad.Catch.throwM e) handler (test e)--catches- :: forall m a- . (MonadCatch m, HasCallStack)- => m a- -- ^ Action to run- -> [ExceptionHandler m a]- -- ^ Recovery actions to run if the first action throws an exception- -- with a type of either @e@ or @'AnnotatedException' e@- -> m a-catches action handlers =- withFrozenCallStack $- Annotated.catches- action- (fmap (\case (ExceptionHandler f) -> Annotated.Handler f) handlers)--try- :: forall e m a- . (Exception e, MonadCatch m, HasCallStack)- => m a- -- ^ Action to run- -> m (Either e a)- -- ^ Returns 'Left' if the action throws an exception with a type- -- of either @e@ or @'AnnotatedException' e@-try action = withFrozenCallStack $ Annotated.try action--tryJust- :: forall e b m a- . (Exception e, MonadCatch m, HasCallStack)- => (e -> Maybe b)- -> m a- -- ^ Action to run- -> m (Either b a)-tryJust test action =- withFrozenCallStack $ Annotated.catch (Right <$> action) $ \e ->- maybe (Control.Monad.Catch.throwM e) (pure . Left) (test e)--withException- :: forall e a m b- . (Exception e, MonadCatch m, HasCallStack)- => m a- -> (e -> m b)- -> m a-withException action onException =- withFrozenCallStack $ Annotated.catch action $ \e -> do- void $ onException e- Control.Monad.Catch.throwM e---- | When dealing with a library that does not use 'AnnotatedException',--- apply this function to augment its exceptions with call stacks.-checkpointCallStack- :: forall m a- . (MonadCatch m, HasCallStack)- => m a- -- ^ Action that might throw whatever types of exceptions- -> m a- -- ^ Action that only throws 'AnnotatedException',- -- where the annotations include a call stack-checkpointCallStack action =- withFrozenCallStack $ Annotated.checkpointCallStack action
− library/Freckle/App/Exception/MonadUnliftIO.hs
@@ -1,133 +0,0 @@-module Freckle.App.Exception.MonadUnliftIO- ( throwM- , throwString- , fromJustNoteM- , impossible- , catch- , catchJust- , catches- , try- , tryJust- , withException- , checkpoint- , checkpointMany- , checkpointCallStack-- -- * Miscellany- , IO- , MonadIO- , MonadUnliftIO- , module Freckle.App.Exception.Types- ) where--import Freckle.App.Exception.Types--import Control.Applicative (pure)-import Control.Exception.Annotated.UnliftIO (checkpoint, checkpointMany)-import Control.Monad (void)-import Data.Either (Either (..))-import Data.Function (($), (.))-import Data.Functor (fmap, (<$>))-import Data.Maybe (Maybe, maybe)-import Data.String (String)-import GHC.IO.Exception (userError)-import GHC.Stack (withFrozenCallStack)-import System.IO (IO)-import UnliftIO (MonadIO, MonadUnliftIO)--import Control.Exception.Annotated.UnliftIO qualified as Annotated-import UnliftIO.Exception qualified---- Throws an exception, wrapped in 'AnnotatedException' which includes a call stack-throwM :: forall e m a. (Exception e, MonadIO m, HasCallStack) => e -> m a-throwM e = withFrozenCallStack $ Annotated.throw e--throwString :: forall m a. (MonadIO m, HasCallStack) => String -> m a-throwString s = withFrozenCallStack $ throwM $ userError s--fromJustNoteM- :: forall m a. (MonadIO m, HasCallStack) => String -> Maybe a -> m a-fromJustNoteM err = withFrozenCallStack $ maybe (throwString err) pure--impossible :: forall m a. (MonadIO m, HasCallStack) => m a-impossible = withFrozenCallStack $ throwString "Impossible"--catch- :: forall e m a- . (Exception e, MonadUnliftIO m, HasCallStack)- => m a- -> (e -> m a)- -> m a-catch action handler = withFrozenCallStack $ Annotated.catch action handler--catchJust- :: forall e b m a- . (Exception e, MonadUnliftIO m, HasCallStack)- => (e -> Maybe b)- -> m a- -> (b -> m a)- -> m a-catchJust test action handler =- withFrozenCallStack $ Annotated.catch action $ \e ->- maybe (UnliftIO.Exception.throwIO e) handler (test e)--catches- :: forall m a- . (MonadUnliftIO m, HasCallStack)- => m a- -- ^ Action to run- -> [ExceptionHandler m a]- -- ^ Recovery actions to run if the first action throws an exception- -- with a type of either @e@ or @'AnnotatedException' e@- -> m a-catches action handlers =- withFrozenCallStack $- Annotated.catches- action- (fmap (\case (ExceptionHandler f) -> Annotated.Handler f) handlers)--try- :: forall e m a- . (Exception e, MonadUnliftIO m, HasCallStack)- => m a- -- ^ Action to run- -> m (Either e a)- -- ^ Returns 'Left' if the action throws an exception with a type- -- of either @e@ or @'AnnotatedException' e@-try = withFrozenCallStack Annotated.try--tryJust- :: forall e b m a- . (Exception e, MonadUnliftIO m, HasCallStack)- => (e -> Maybe b)- -> m a- -- ^ Action to run- -> m (Either b a)-tryJust test action =- withFrozenCallStack $ Annotated.catch (Right <$> action) $ \e ->- maybe (UnliftIO.Exception.throwIO e) (pure . Left) (test e)--withException- :: forall e a m b- . (Exception e, MonadUnliftIO m, HasCallStack)- => m a- -> (e -> m b)- -> m a-withException action onException =- withFrozenCallStack $ Annotated.catch action $ \e -> do- void $ onException e- UnliftIO.Exception.throwIO e---- | When dealing with a library that does not use 'AnnotatedException',--- apply this function to augment its exceptions with call stacks.-checkpointCallStack- :: forall m a- . (MonadUnliftIO m, HasCallStack)- => m a- -- ^ Action that might throw whatever types of exceptions- -> m a- -- ^ Action that only throws 'AnnotatedException',- -- where the annotations include a call stack-checkpointCallStack action =- withFrozenCallStack $- Annotated.checkpointCallStack action
− library/Freckle/App/Exception/Types.hs
@@ -1,15 +0,0 @@-module Freckle.App.Exception.Types- ( ExceptionHandler (..)- , AnnotatedException (..)- , Exception (..)- , SomeException (..)- , HasCallStack- ) where--import Control.Exception (Exception (..), SomeException (..))-import Control.Exception.Annotated (AnnotatedException (..))-import GHC.Stack (HasCallStack)---- Renamed just so that it can go into Freckle.App.Prelude and have a less generic name than 'Handler'-data ExceptionHandler m a- = forall e. Exception e => ExceptionHandler (e -> m a)
− library/Freckle/App/Prelude.hs
@@ -1,185 +0,0 @@-{-# LANGUAGE CPP #-}---- | Those functions and types we can't do without!-module Freckle.App.Prelude- ( module Prelude-- -- * Commonly imported types- , Alternative- , Generic- , HasCallStack- , Hashable- , HashMap- , HashSet- , Int64- , Map- , MonadIO- , MonadReader- , MonadUnliftIO- , NominalDiffTime- , NonEmpty- , PrimMonad- , ReaderT- , Set- , Text- , UTCTime- , Vector-- -- * Commonly used functions-- -- ** Lifts- , lift- , liftIO-- -- ** 'Text'- , tshow- , pack- , unpack- , encodeUtf8- , decodeUtf8-- -- ** 'Maybe'- , catMaybes- , fromMaybe- , isJust- , isNothing- , listToMaybe- , mapMaybe- , maybeToList-- -- ** Safe alternatives to partial prelude functions (e.g. 'headMay')- , module SafeAlternatives-- -- ** 'Either'- , partitionEithers-- -- ** 'Foldable'- , module Foldable-- -- ** 'Traversable'- , module Traversable-- -- ** 'Functor'- , (<$$>)-- -- ** 'Bifunctor'- , bimap- , first- , second-- -- ** 'Applicative'- , (<|>)- , liftA2- , optional-- -- ** 'Monad'- , (<=<)- , (>=>)- , guard- , join- , unless- , void- , when-- -- ** 'Arrow'- , (&&&)- , (***)-- -- ** 'UTCTime'- , getCurrentTime-- -- * Exceptions- , throwM- , throwString- , fromJustNoteM- , catch- , catchJust- , catches- , try- , tryJust- , impossible- , ExceptionHandler (..)- , Exception (displayException)- , SomeException (..)- ) where---- Use 'Prelude' as the starting point, removing common partial functions--import Prelude hiding- ( cycle- , foldl1- , foldr1- , head- , init- , last-#if MIN_VERSION_base(4,18,0)- , liftA2-#endif- , maximum- , minimum- , read- , tail- , (!!)- )---- Commonly used types (and their commonly used functions)--import Control.Applicative (Alternative, liftA2, optional, (<|>))-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Primitive (PrimMonad)-import Control.Monad.Reader (MonadReader, ReaderT)-import Data.HashMap.Strict (HashMap)-import Data.HashSet (HashSet)-import Data.Hashable (Hashable)-import Data.Int (Int64)-import Data.List.NonEmpty (NonEmpty)-import Data.Map.Strict (Map)-import Data.Set (Set)-import Data.Text (Text, pack, unpack)-import Data.Time (NominalDiffTime, UTCTime, getCurrentTime)-import Data.Vector (Vector)-import Freckle.App.Exception-import GHC.Generics (Generic)---- Safe alternatives to prelude functions--import Data.Semigroup.Foldable as SafeAlternatives (fold1, foldMap1)-import Safe as SafeAlternatives- ( atMay- , cycleMay- , headMay- , initMay- , lastMay- , maximumMay- , minimumMay- , readMay- , tailMay- )---- Commonly used functions--import Control.Arrow ((&&&), (***))-import Control.Monad (guard, join, unless, void, when, (<=<), (>=>))-import Control.Monad.Trans (lift)-import Data.Bifunctor (bimap, first, second)-import Data.Either (partitionEithers)-import Data.Foldable as Foldable hiding (foldl1, foldr1)-import Data.Maybe- ( catMaybes- , fromMaybe- , isJust- , isNothing- , listToMaybe- , mapMaybe- , maybeToList- )-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import Data.Traversable as Traversable--infixl 4 <$$>-(<$$>) :: (Functor c, Functor d) => (a -> b) -> c (d a) -> c (d b)-f <$$> as = (f <$>) <$> as---- | 'Show' as 'Text'-tshow :: Show a => a -> Text-tshow = pack . show
+ library/Freckle/App/Test/Hspec/AnnotatedException.hs view
@@ -0,0 +1,22 @@+module Freckle.App.Test.Hspec.AnnotatedException+ ( unwrapAnnotatedHUnitFailure+ ) where++import Freckle.App.Prelude++import Control.Exception qualified+import Freckle.App.Exception (AnnotatedException (..))+import Test.HUnit.Lang (HUnitFailure)+import Test.Hspec++-- | An hspec hook that lets hspec catch and pretty-print 'HUnitFailure', the+-- exception that is thrown when a test assertion fails+--+-- Tests for any code that might throw 'AnnotatedException' (which includes anything+-- that uses freckle-app) should add this hook to their test suite. Without it, if+-- you end up with an @'AnnotatedException' 'HUnitFailure'@, hspec doesn't recognize+-- it as an assertion failure and you get ugly output instead of nice output.+unwrapAnnotatedHUnitFailure :: Spec -> Spec+unwrapAnnotatedHUnitFailure = around_ $+ Control.Exception.handle $ \AnnotatedException {exception = e} ->+ Control.Exception.throw (e :: HUnitFailure)
package.yaml view
@@ -1,5 +1,5 @@ name: freckle-app-version: 1.20.0.1+version: 1.20.1.0 maintainer: Freckle Education category: Utils github: freckle/freckle-app@@ -66,18 +66,23 @@ - Freckle.App.Http.Paginate - Freckle.App.Http.Retry - Freckle.App.HttpSpec+ - Freckle.App.Prelude+ - Freckle.App.Exception+ - Freckle.App.Exception.MonadThrow+ - Freckle.App.Exception.MonadUnliftIO+ - Freckle.App.Exception.Types - Freckle.App.Test.Http - Freckle.App.Test.Http.MatchRequest dependencies: - Blammo - Blammo-wai - Glob+ - HUnit - MonadRandom - QuickCheck - autodocodec - autodocodec-openapi3 - aeson- - annotated-exception - bcp47 - bugsnag >= 1.1.0.0 # Network.Bugsnag.MetaData - bytestring@@ -94,9 +99,10 @@ - extra - faktory - freckle-env+ - freckle-exception - freckle-http - freckle-otel- - hashable+ - freckle-prelude - hs-opentelemetry-api - hs-opentelemetry-instrumentation-persistent - hs-opentelemetry-instrumentation-wai@@ -110,7 +116,6 @@ - immortal - lens - monad-control- - monad-logger-aeson - monad-validate - mtl - nonempty-containers@@ -122,7 +127,6 @@ - primitive - resource-pool >= 0.4.0.0 # defaultPoolConfig, etc - resourcet- - safe - scientist - semigroupoids - template-haskell