assert-failure-0.1.3.0/0000755000000000000000000000000007346545000012770 5ustar0000000000000000assert-failure-0.1.3.0/Control/Exception/Assert/0000755000000000000000000000000007346545000017607 5ustar0000000000000000assert-failure-0.1.3.0/Control/Exception/Assert/Sugar.hs0000644000000000000000000001123007346545000021221 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Syntactic sugar that improves the usability of 'Control.Exception.assert' -- and 'error'. The original @assert@ function is here re-exported -- for convenience. -- -- Make sure to enable assertions for your cabal package, e.g., by setting -- -- > ghc-options: -fno-ignore-asserts -- -- in your .cabal file. Otherwise, some of the functions will have -- no effect at all. module Control.Exception.Assert.Sugar ( assert, blame, showFailure, swith, allB -- * DEPRECATED , twith, failure, forceEither ) where import Control.Exception (assert) import Data.Text (Text) import Debug.Trace (trace) import Prelude import qualified Text.Show.Pretty as Show.Pretty (ppShow) infix 1 `blame` -- | If the condition fails, display the value blamed for the failure. -- Used as in -- -- > assert (age < 120 `blame` age) $ savings / (120 - age) blame :: Show v => Bool -> v -> Bool {-# INLINABLE blame #-} blame True _ = True blame False blamed = trace (blameMessage blamed) False blameMessage :: Show v => v -> String blameMessage blamed = "Contract failed and the following is to blame:\n " ++ Show.Pretty.ppShow blamed infix 2 `showFailure` -- | A helper function for 'error'. To be used as in -- -- > case xs of -- > 0 : _ -> error $ "insignificant zero" `showFailure` xs -- -- Fixing the first argument to @String@ instead of anything Showable -- prevents warnings about defaulting, even when @OverloadedStrings@ -- extension is enabled. showFailure :: Show v => String -> v -> String {-# INLINABLE showFailure #-} showFailure s blamed = "Internal failure occurred and the following is to blame:\n " ++ s ++ "\n " ++ Show.Pretty.ppShow blamed infix 2 `swith` -- | Syntactic sugar for the pair operation, to be used for 'blame' as in -- -- > assert (age < 120 `blame` "age too high" `swith` age) $ savings / (120 - age) -- -- Fixing the first component of the pair to @String@ prevents warnings -- about defaulting, even when @OverloadedStrings@ extension is enabled. swith :: String -> v -> (String, v) {-# INLINE swith #-} swith s blamed = (s, blamed) -- | Like 'List.all', but if the predicate fails, blame all the list elements -- and especially those for which it fails. To be used as in -- -- > assert (allB (<= height) [yf, y1, y2]) allB :: Show v => (v -> Bool) -> [v] -> Bool {-# INLINABLE allB #-} allB predicate l = case all predicate l of True -> True False -> trace (allBMessage predicate l) False allBMessage :: Show v => (v -> Bool) -> [v] -> String {-# INLINABLE allBMessage #-} allBMessage predicate l = "The following items on the list don't respect the contract:\n" ++ Show.Pretty.ppShow (filter (not . predicate) l) ++ "\nout of all the list items below:\n" ++ Show.Pretty.ppShow l -- * DEPRECATED infix 2 `twith` -- | Syntactic sugar for the pair operation, to be used for 'blame' as in -- -- > assert (age < 120 `blame` "age too high" `twith` age) $ savings / (120 - age) -- Fixing the first component of the pair to @Text@ prevents warnings -- about defaulting, even when @OverloadedStrings@ extension is enabled. {-# DEPRECATED twith "consider using 'swith' instead, for simplicity, because GHC optimizes lazy 'String' constants very well." #-} twith :: Text -> b -> (Text, b) {-# INLINE twith #-} twith t b = (t, b) infix 1 `failure` -- | Like 'error', but shows the source position (in newer GHCs -- @error@ shows source position as well, hence deprecation) -- and also the value to blame for the failure. To be used as in -- -- > case xs of -- > 0 : _ -> assert `failure` (xs, "has an insignificant zero") {-# DEPRECATED failure "use 'error' and 'showFailure' instead, now that 'error' prints source positions." #-} failure :: Show a => (forall x. Bool -> x -> x) -> a -> b {-# NOINLINE failure #-} failure asrt blamed = let s = "Internal failure occurred and the following is to blame:\n " ++ Show.Pretty.ppShow blamed in trace s $ asrt False $ error "Control.Exception.Assert.Sugar.failure" -- Lack of no-ignore-asserts or GHC < 7.4. infix 1 `forceEither` -- | Assuming that @Left@ signifies an error condition, -- check the @Either@ value and, if @Left@ is encountered, -- fail outright and show the error message (in newer GHCs -- @error@ shows source position as well, hence deprecation). Used as in -- -- > assert `forceEither` parseOrFailWithMessage code forceEither :: Show a => (forall x. Bool -> x -> x) -> Either a b -> b {-# DEPRECATED forceEither "use 'either (error . show) id' instead, now that 'error' prints source positions." #-} {-# NOINLINE forceEither #-} forceEither asrt (Left a) = asrt `failure` a forceEither _ (Right b) = b assert-failure-0.1.3.0/LICENSE0000644000000000000000000000276607346545000014010 0ustar0000000000000000BSD 3-Clause License Copyright (c) 2015-2022, Mikolaj Konarski All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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. assert-failure-0.1.3.0/README.md0000644000000000000000000000141607346545000014251 0ustar0000000000000000assert-failure [![Hackage](https://img.shields.io/hackage/v/assert-failure.svg)](https://hackage.haskell.org/package/assert-failure) ============== This library contains syntactic sugar that makes it easier to write simple contracts with 'assert' and 'error' and report the values that violate contracts. The original 'assert' function is here re-exported for convenience. Make sure to enable assertions for your cabal package, e.g., by setting ghc-options: -fno-ignore-asserts in your .cabal file. Otherwise, some of the functions will have no effect at all. The library emerged from the chaos of the tons of assertions (sometimes augmented by comments and trace printouts) and 'error' calls in the [LambdaHack](http://hackage.haskell.org/package/LambdaHack) game engine. assert-failure-0.1.3.0/Setup.hs0000644000000000000000000000005607346545000014425 0ustar0000000000000000import Distribution.Simple main = defaultMain assert-failure-0.1.3.0/assert-failure.cabal0000644000000000000000000000414407346545000016705 0ustar0000000000000000cabal-version: >= 1.10 name: assert-failure -- The package version. See the Haskell package versioning policy (PVP) -- for standards guiding when and how versions should be incremented. -- http://www.haskell.org/haskellwiki/Package_versioning_policy -- PVP summary:+-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change version: 0.1.3.0 synopsis: Syntactic sugar improving 'assert' and 'error' description: This library contains syntactic sugar that makes it easier to write simple contracts with 'assert' and 'error' and report the values that violate contracts. homepage: https://github.com/Mikolaj/assert-failure bug-reports: https://github.com/Mikolaj/assert-failure/issues license: BSD3 license-file: LICENSE tested-with: GHC ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.3 || ==9.4 || ==9.6 data-files: LICENSE, README.md author: Mikolaj Konarski maintainer: Mikolaj Konarski category: Control, Contract build-type: Simple source-repository head type: git location: git://github.com/Mikolaj/assert-failure.git library exposed-modules: Control.Exception.Assert.Sugar -- other-modules: build-depends: base >= 4.6 && < 99, text >= 0.11.2.3, pretty-show >= 1.6 default-language: Haskell2010 default-extensions: MonoLocalBinds, ScopedTypeVariables, OverloadedStrings BangPatterns, RecordWildCards, NamedFieldPuns, MultiWayIf, LambdaCase, DefaultSignatures, InstanceSigs, PatternSynonyms -- TODO: more, after old GHCs dropped other-extensions: RankNTypes ghc-options: -Wall -fwarn-orphans -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-implicit-prelude -fwarn-identities -- TODO: more, after old GHCs dropped ghc-options: -fno-ignore-asserts