tehepero (empty) → 0

raw patch · 5 files changed

+146/−0 lines, 5 filesdep +basedep +exceptionsdep +falliblesetup-changed

Dependencies added: base, exceptions, fallible, prettyprinter, prettyprinter-ansi-terminal

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• src/Control/Panic.hs +80/−0
• tehepero.cabal +29/−0

@@ -0,0 +1,5 @@+# Revision history for tehepero++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright Fumiaki Kinoshita (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Fumiaki Kinoshita nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,80 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+module Control.Panic+  (Panic(..)+  , PrettyEx(..)+  , panic+  , unwrap+  , expect+  , withPanic) where++import Control.Monad.Catch+import Data.Fallible+import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Terminal+import GHC.Stack+import System.IO (stderr)+import System.Exit (exitFailure)++data Panic = Panic !CallStack !(Doc AnsiStyle)+  deriving (Show)+instance Exception Panic++class PrettyEx a where+  prettyEx :: a -> Doc AnsiStyle+  prettyExList :: [a] -> Doc AnsiStyle+  prettyExList = foldMap prettyEx++instance (a ~ AnsiStyle) => PrettyEx (Doc a) where+  prettyEx = id++instance PrettyEx () where+  prettyEx _ = "Nothing"++instance PrettyEx Char where+  prettyEx = pretty+  prettyExList = pretty++instance PrettyEx a => PrettyEx [a] where+  prettyEx = annotate (color Cyan) . prettyExList++instance PrettyEx CallStack where+  prettyEx = vsep . map prettyCallSite . getCallStack where+    prettyCallSite (f, loc) = annotate bold (pretty f) <> ", called at " <> prettyEx loc++instance PrettyEx SrcLoc where+  prettyEx SrcLoc {..} = mconcat+      [ annotate (color Blue) (pretty srcLocFile), ":"+      , pretty srcLocStartLine, ":"+      , pretty srcLocStartCol, " in "+      , annotate (color Yellow) $ pretty srcLocPackage, ":", pretty srcLocModule+      ]++instance PrettyEx Panic where+  prettyEx (Panic stack doc) = vsep [annotate (color Red <> bold) "!!!Panic!!!", doc, prettyEx stack]++-- | Throw an error with a pretty-printable message.+panic :: (MonadThrow m, HasCallStack) => Doc AnsiStyle -> m a+panic = throwM . Panic (popCallStack callStack)+{-# INLINE panic #-}++-- | Try to obtain the result of a 'Fallible' value. If 'panic's it fails.+unwrap :: (Fallible f, PrettyEx (Failure f), MonadThrow m, HasCallStack)+  => f a -> m a+unwrap = either (panic . prettyEx) pure . tryFallible+{-# INLINE unwrap #-}++-- | Prepend a message if it fails to obtain the result.+expect :: (Fallible f, PrettyEx (Failure f), MonadThrow m, HasCallStack)+  => Doc AnsiStyle -> f a -> m a+expect e = either (panic . (prefix<>) . prettyEx) pure . tryFallible where+  prefix = e <> ": "+{-# INLINE expect #-}++-- | Add an exception handler for 'Panic' with prettifed output.+withPanic :: IO a -> IO a+withPanic m = m `catch` \e -> do+  hPutDoc stderr $ prettyEx (e :: Panic) <> hardline+  exitFailure

@@ -0,0 +1,29 @@+cabal-version:       2.4+name:                tehepero+version:             0+synopsis:            Prettier error+description:         Haskell port of Rust's unwrap and except+bug-reports:         https://github.com/fumieval/tehepero+license:             BSD-3-Clause+license-file:        LICENSE+author:              Fumiaki Kinoshita+maintainer:          fumiexcel@gmail.com+copyright:           Copyright (c) 2020- Fumiaki Kinoshita+category:            Control+extra-source-files:  CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/fumieval/tehepero++library+  exposed-modules:     Control.Panic+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.12.0.0 && <4.15+    , prettyprinter+    , prettyprinter-ansi-terminal+    , exceptions+    , fallible+  hs-source-dirs:      src+  default-language:    Haskell2010