uniform-error (empty) → 0.1.0

raw patch · 5 files changed

+244/−0 lines, 5 filesdep +basedep +monads-tfdep +safesetup-changed

Dependencies added: base, monads-tf, safe, uniform-strings

Files

• ChangeLog.md +8/−0
• README.md +20/−0
• Setup.lhs +6/−0
• Uniform/Error.hs +169/−0
• uniform-error.cabal +41/−0

@@ -0,0 +1,8 @@+0.0.10+    move from the 0.0.9 versions in Workspace8 2019+    change to uniform approach:+        test/Testing.hs+        .ghci +        cleaned +0.0.10.1 added (moved) startApp from +0.1.0   cleaned and removed unnecessary comments and functions

@@ -0,0 +1,20 @@+`Error.hs` defines an uniform approach to error:+    any function which can fail returns a value of +    - `ErrIO`, which is a wrapper around `IO`, returning a `Text` messages if the computation fails +    - `ErrOrVal` (which is `Either Text`) for functions not in the IO monad++All cases where functions use other error signaling methods must be converted as part of their integration into the uniform framework. ++Especially important are the functions to convert to regular IO: ++- `callIO` which calls an IO function and catches a possible error return.  ++- converts back functions running in `ErrIO a` into (normal) `IO (ErrOrVal a)` which is used when functions from the uniform style are used where functions in the normal IO monad are expected. ++Some other functions are helpful to identify hard to track problems in Haskell: ++`undef` to find where an undefined value is used, producing an error message. ++The StartApp is a bridge between the ErrIO used here and the standard IO monad in `main:: IO ()`++The package depends on uniform-string.

@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+

@@ -0,0 +1,169 @@+----------------------------------------------------------------------+--+-- Module      :  Uniform.Error+--+----------------------------------------------------------------------++    {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+-- runErrorT is depreceiated but used in monads-tf+{-# OPTIONS_GHC -w #-}++module Uniform.Error+  ( module Uniform.Error,+    -- module Uniform.Strings,+    module Safe,+    module Control.Monad.Error, -- is monads-tf+    module Control.Exception, -- to avoid control.error+  )+where++import Control.Exception (Exception, SomeException, bracket, catch)+import "monads-tf" Control.Monad.Error (Error, ErrorT, ErrorType, MonadError, MonadIO, catchError, liftIO, runErrorT, throwError, unless, when)+import Safe (headNote, readNote)+import Uniform.Strings hiding (S, (<.>), (</>))++instance CharChains2 IOError Text where+  show' = s2t . show++type ErrOrVal = Either Text++type ErrIO = ErrorT Text IO++instance Exception [Text]+++toErrOrVal :: Either String a -> ErrOrVal a+toErrOrVal (Left s) = Left (s2t s)+toErrOrVal (Right r) = Right r++-- | runErr to avoid the depreceated message for runErrorT, which is identical+runErr :: ErrIO a -> IO (ErrOrVal a)+runErr = runErrorT++runErrorVoid :: ErrIO () -> IO ()+-- ^ run an operation in ErrIO which is not returning anything+-- simpler to use than runErr+runErrorVoid a = do+  res <- runErr a+  case res of+    Left msg -> error (t2s msg)+    Right _ -> return ()++undef :: Text -> a+undef = error . t2s+-- ^ for type specification, not to be evaluated++fromRightEOV :: ErrOrVal a -> a+fromRightEOV (Right a) = a+fromRightEOV (Left msg) = errorT ["fromrightEOV", msg]++bracketErrIO ::+  -- | computation to run first (\"acquire resource\")+  ErrIO a ->+  -- | computation to run last (\"release resource\")+  (a -> ErrIO b) ->+  -- | computation to run in-between+  (a -> ErrIO c) ->+  ErrIO c -- returns the value from the in-between computation+  --bracketErrIO before after thing = bracket before after thing+  -- no way to catch IO errors reliably in ErrIO -- missing Monad Mask or similar+bracketErrIO before after thing =+  fmap fromRightEOV . callIO $+    bracket+      ( do+          ra <- runErr $ before+          return ra --  (ra :: ErrOrVal a) )+      )+      (\a -> runErr $ after . fromRightEOV $ a)+      (\a -> runErr $ thing . fromRightEOV $ a)++instance Error Text++callIO :: (MonadError m, MonadIO m, ErrorType m ~ Text) => IO a -> m a+-- | this is using catch to grab all errors+callIO op = do+  r2 <-+    liftIO $+      do+        r <- op+        return $ Right r+        `catch` ( \e -> do+                    --                         putStrLn "callIO catch caught error\n"+                    return . Left $ (e :: SomeException)+                )+  case r2 of+    Left e -> do+      --                        putIOwords ["\ncallIO Left branch\n", showT e, "throwError\n"]+      throwError (showT e)+    Right v -> return v+++throwErrorT :: [Text] -> ErrIO a+-- throw an error with a list of texts as a text+throwErrorT = throwError . unwordsT++maybe2error :: Maybe a -> ErrIO a+maybe2error Nothing = fail "was Nothing"+maybe2error (Just a) = return a++errorT :: [Text] -> a+-- ^ a list of texts is output with failure+errorT = error . t2s . unwordsT++errorWords :: [Text] -> a+errorWords = errorT++fromJustNoteT :: [Text] -> Maybe a -> a+-- produce error with msg when Nothing, msg is list of texts+fromJustNoteT msgs a = fromJustNote (t2s . unlinesT $ msgs) a++fromRightNoteString :: Text -> Either String b -> b+-- produce an error when assuming that a value is Right+fromRightNoteString msg (Left a) = errorT ["fromRight", showT a, msg]+fromRightNoteString _ (Right a) = a++fromRightNote :: Text -> Either Text b -> b+-- produce an error when assuming that a value is Right+fromRightNote msg (Left a) = errorT ["fromRight", showT a, msg]+fromRightNote _ (Right a) = a++headNoteT :: [Text] -> [a] -> a+-- get head with a list of texts+headNoteT msg s = headNote (t2s $ unwords' msg) s++startProg :: Show a => Text -> ErrIO a -> IO ()+startProg programName mainProg =+  do+    putIOwords+      [ "------------------ ",+        programName,+        " ----------------------------\n"+      ]+    r <- runErr $ mainProg+    putIOwords+      [ "\n------------------",+        "main",+        programName,+        "\nreturning",+        either id showT r,+        "\n"+      ]+    return ()+    `catchError` ( \e -> do+                     putIOwords+                       [ "startProg error caught\n",+                         programName,+                         "\n",+                         showT e+                       ]+                     return ()+                 )+

@@ -0,0 +1,41 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 7f798466051704587a2355486782bd1165e67a54c1ac54700691c2f06af5fd92++name:           uniform-error+version:        0.1.0+synopsis:       Handling errors in the uniform framework+description:    A minimal package to handle errors and exception+                in a simple but flexible way. Includes functions to adapt the prefered method of calling IO with error handling (ErrIO) to the +                approaches encountered in other packages when writing applications.+                .+                Please see the README on GitHub at <https://github.com/andrewufrank/uniform-error/readme>+category:       Error Exception Uniform+bug-reports:    https://github.com/andrewufrank/uniform-error/issues+author:         Andrew Frank+maintainer:     Andrew U. Frank <uniform@gerastree.at>+copyright:      2021 Andrew U. Frank+license:        GPL-2.0-only+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++library+  exposed-modules:+      Uniform.Error+  other-modules:+      Paths_uniform_error+  hs-source-dirs:+      ./.+  build-depends:+      base >=4.7 && <5+    , monads-tf+    , safe+    , uniform-strings+  default-language: Haskell2010+  autogen-modules: Paths_uniform_error