diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,22 +1,19 @@ -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 + 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.1.2 moved to Control.Monad.Exception - -0.1.3 some improvements, pushed on hackage +0.1.3 some improvements, pushed on hackage added stack build for 19.16 (9.0.2) -0.1.3.1 maintenance to fix #1 -- checked with ghc 8.10.7 +0.1.3.1 maintenance to fix #1 -- checked with ghc 8.10.7 import HTF (Test.Framework.HUnitWrapper) unqualified to get the asserts (export in HTF 0.15.0.0 changed see the change log) - 0.1.3.2 moved the NoticeLevel to a module in uniform-error -0.1.5.1 for ghc 9.2.5 +0.1.5 branch for ghc 9.2.5 +0.1.5.1 diff --git a/Uniform/Error.hs b/Uniform/Error.hs --- a/Uniform/Error.hs +++ b/Uniform/Error.hs @@ -12,6 +12,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- runErrorT is depreceiated but used in monads-tf {-# OPTIONS_GHC -w #-} @@ -23,7 +24,9 @@ , module Control.Monad , module Control.Monad.Trans.Except , liftIO, MonadIO + , errorT, errorWords , SomeException + , module Uniform.NoticeLevel -- , module Control.Monad.IO.Class -- module Control.Monad.Error, -- is monads-tf @@ -34,6 +37,7 @@ import Control.Exception (Exception, SomeException, bracket, catch, throw, SomeException) import Control.Monad -- just to make it available everywhere import Control.Monad.IO.Class (liftIO, MonadIO) +import Uniform.NoticeLevel -- import "monads-tf" Control.Monad.Error (Error, ErrorT, ErrorType, MonadError, MonadIO, catchError, liftIO, runErrorT, throwError, unless, when) -- ErrorT Text IO xxx becomes ErrIO xxx @@ -68,6 +72,13 @@ case res of Left msg -> error (t2s msg) Right _ -> return () + +errio2io :: ExceptT Text IO a -> IO a +errio2io op = do + res :: Either Text a <- runErr op + case res of + Left msg -> fail . t2s $ msg + Right a1 -> return a1 undef :: Text -> a undef = error . t2s diff --git a/Uniform/NoticeLevel.hs b/Uniform/NoticeLevel.hs --- a/Uniform/NoticeLevel.hs +++ b/Uniform/NoticeLevel.hs @@ -6,15 +6,16 @@ -- ---------------------------------------------------------------------- - {-# LANGUAGE BangPatterns #-} + -- {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE PackageImports #-} +-- {-# LANGUAGE PackageImports #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- runErrorT is depreceiated but used in monads-tf @@ -29,13 +30,41 @@ import Uniform.Strings hiding (S, (<.>), ()) import Data.Default import GHC.Generics +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad (when) +import Data.Data -data NoticeLevel = NoticeLevel0 | NoticeLevel1 | NoticeLevel2 deriving (Eq, Ord, Show, Read, Generic) +-- | increasing noticeLevels produce more output +data NoticeLevel = NoticeLevel0 | NoticeLevel1 | NoticeLevel2 deriving (Eq, Ord, Show, Read, Generic, Data) instance Zeros NoticeLevel where zero = NoticeLevel0 instance Default NoticeLevel where def = NoticeLevel2 -inform, informNone, informAll :: NoticeLevel -> Bool +inform, informNone, informAll, informOne:: NoticeLevel -> Bool inform = not . isZero informNone = const False -- to use with: when (informNone debug) informAll = const True +informOne debug = debug > NoticeLevel0 +informTwo debug = debug > NoticeLevel1 +-- should only print most important messages + +putInform :: MonadIO m => NoticeLevel -> [Text] -> m () +-- produce output if debug > NoticeLevel0 +putInform debug texts = when (inform debug) $ + putIOwords texts + +putInformZero :: MonadIO m => NoticeLevel -> [Text] -> m () +-- produce always output +putInformZero debug texts = putIOwords texts + +putInformOne :: MonadIO m => NoticeLevel -> [Text] -> m () +-- produce output if debug > NoticeLevel0 +putInformOne debug texts = when (informOne debug) $ + putIOwords texts + +putInformTwo :: MonadIO m => NoticeLevel -> [Text] -> m () +-- produce output if debug > NoticeLevel1 +putInformTwo debug texts = when (informTwo debug) $ + putIOwords texts + + diff --git a/uniform-error.cabal b/uniform-error.cabal --- a/uniform-error.cabal +++ b/uniform-error.cabal @@ -1,13 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.39.3. -- -- see: https://github.com/sol/hpack --- --- hash: 04c7eb729e6ca2692054929f92a15ea8782725700adbaa1e5e66b4b8d4cd15d9 name: uniform-error -version: 0.1.5.1 +version: 0.1.5.2 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 @@ -15,7 +13,6 @@ . Please see the README on GitHub at category: Error Exception Uniform -homepage: https://github.com/github.com:andrewufrank/uniform-error.git#readme bug-reports: https://github.com/andrewufrank/uniform-error/issues author: Andrew Frank maintainer: Andrew U. Frank @@ -26,10 +23,6 @@ README.md ChangeLog.md -source-repository head - type: git - location: https://github.com/github.com:andrewufrank/uniform-error.git - library exposed-modules: Uniform.Error @@ -43,7 +36,7 @@ , data-default , safe , transformers - , uniform-strings >=0.1.5 + , uniform-strings default-language: Haskell2010 autogen-modules: Paths_uniform_error @@ -65,5 +58,5 @@ , safe , transformers , uniform-error - , uniform-strings >=0.1.5 + , uniform-strings default-language: Haskell2010