packages feed

freckle-exception (empty) → 0.0.0.0

raw patch · 9 files changed

+481/−0 lines, 9 filesdep +aesondep +annotated-exceptiondep +base

Dependencies added: aeson, annotated-exception, base, exceptions, monad-logger-aeson, unliftio

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-exception-v0.0.0.0...main)++## [v0.0.0.0](https://github.com/freckle/freckle-app/tree/freckle-exception-v0.0.0.0/freckle-exception)++First release, sprouted from `freckle-app-1.20.0.1`.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2023-2024 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,7 @@+# freckle-exception++Some extensions to the [annotated-exception](https://hackage.haskell.org/package/annotated-exception) library.++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ freckle-exception.cabal view
@@ -0,0 +1,55 @@+cabal-version:      1.18+name:               freckle-exception+version:            0.0.0.0+license:            MIT+license-file:       LICENSE+maintainer:         Freckle Education+homepage:           https://github.com/freckle/freckle-app#readme+bug-reports:        https://github.com/freckle/freckle-app/issues+synopsis:           Some extensions to the annotated-exception library+description:        Please see README.md+category:           Exceptions+build-type:         Simple+extra-source-files: package.yaml+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/freckle/freckle-app++library+    exposed-modules:+        Freckle.App.Exception+        Freckle.App.Exception.MonadThrow+        Freckle.App.Exception.MonadUnliftIO+        Freckle.App.Exception.Types++    hs-source-dirs:     library+    other-modules:      Paths_freckle_exception+    default-language:   GHC2021+    default-extensions:+        DataKinds DeriveAnyClass DerivingVia DerivingStrategies GADTs+        LambdaCase NoImplicitPrelude NoMonomorphismRestriction+        OverloadedStrings TypeFamilies++    ghc-options:+        -fignore-optim-changes -fwrite-ide-info -Weverything+        -Wno-all-missed-specialisations -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-kind-signatures+        -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+        -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+        -Wno-safe -Wno-unsafe++    build-depends:+        aeson >=2.0.3.0,+        annotated-exception >=0.2.0.4,+        base >=4.16.4.0 && <5,+        exceptions >=0.10.4,+        monad-logger-aeson >=0.4.0.4,+        unliftio >=0.2.25.0++    if impl(ghc >=9.8)+        ghc-options:+            -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures
+ library/Freckle/App/Exception.hs view
@@ -0,0 +1,53 @@+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 view
@@ -0,0 +1,131 @@+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 view
@@ -0,0 +1,133 @@+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 view
@@ -0,0 +1,15 @@+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)
+ package.yaml view
@@ -0,0 +1,61 @@+name: freckle-exception+version: 0.0.0.0+maintainer: Freckle Education+category: Exceptions+github: freckle/freckle-app+synopsis: Some extensions to the annotated-exception library+description: Please see README.md++extra-doc-files:+  - README.md+  - CHANGELOG.md++extra-source-files:+  - package.yaml++language: GHC2021++ghc-options:+  - -fignore-optim-changes+  - -fwrite-ide-info+  - -Weverything+  - -Wno-all-missed-specialisations+  - -Wno-missing-exported-signatures # re-enables missing-signatures+  - -Wno-missing-import-lists+  - -Wno-missing-kind-signatures+  - -Wno-missing-local-signatures+  - -Wno-missing-safe-haskell-mode+  - -Wno-monomorphism-restriction+  - -Wno-prepositive-qualified-module+  - -Wno-safe+  - -Wno-unsafe++when:+  - condition: "impl(ghc >= 9.8)"+    ghc-options:+      - -Wno-missing-role-annotations+      - -Wno-missing-poly-kind-signatures++dependencies:+  - base < 5++default-extensions:+  - DataKinds+  - DeriveAnyClass+  - DerivingVia+  - DerivingStrategies+  - GADTs+  - LambdaCase+  - NoImplicitPrelude+  - NoMonomorphismRestriction+  - OverloadedStrings+  - TypeFamilies++library:+  source-dirs: library+  dependencies:+    - aeson+    - annotated-exception+    - exceptions+    - monad-logger-aeson+    - unliftio