assert-failure-0.1.2.2/0000755000000000000000000000000013157032175012772 5ustar0000000000000000assert-failure-0.1.2.2/assert-failure.cabal0000644000000000000000000000400613157032175016704 0ustar0000000000000000name: 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.2.2 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.6 && <= 8.2 data-files: LICENSE, README.md author: Mikolaj Konarski maintainer: Mikolaj Konarski category: Control, Contract build-type: Simple cabal-version: >= 1.10 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 && < 5, text >= 0.11.2.3 && < 2, pretty-show >= 1.6 && < 2 default-language: Haskell2010 default-extensions: MonoLocalBinds, ScopedTypeVariables, OverloadedStrings BangPatterns, RecordWildCards, NamedFieldPuns, MultiWayIf other-extensions: RankNTypes ghc-options: -Wall -fwarn-orphans -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-implicit-prelude -fwarn-identities -- TODO: ghc-options: -Wall -Wcompat -Worphans -Wincomplete-uni-patterns -Wincomplete-record-updates -Wimplicit-prelude -Wmissing-home-modules -Widentities ghc-options: -fno-ignore-asserts assert-failure-0.1.2.2/LICENSE0000644000000000000000000000272413157032175014004 0ustar0000000000000000Copyright (c) 2015, 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: * 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 the {organization} 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.2.2/Setup.hs0000644000000000000000000000005613157032175014427 0ustar0000000000000000import Distribution.Simple main = defaultMain assert-failure-0.1.2.2/README.md0000644000000000000000000000160613157032175014254 0ustar0000000000000000assert-failure [![Build Status](https://secure.travis-ci.org/Mikolaj/assert-failure.png)](http://travis-ci.org/Mikolaj/assert-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.2.2/Control/0000755000000000000000000000000013157032175014412 5ustar0000000000000000assert-failure-0.1.2.2/Control/Exception/0000755000000000000000000000000013157032175016350 5ustar0000000000000000assert-failure-0.1.2.2/Control/Exception/Assert/0000755000000000000000000000000013157032175017611 5ustar0000000000000000assert-failure-0.1.2.2/Control/Exception/Assert/Sugar.hs0000644000000000000000000001077713157032175021242 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 , failure, twith, 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 a => Bool -> a -> Bool {-# INLINE blame #-} blame True _ = True blame False blamed = trace (blameMessage blamed) False blameMessage :: Show a => a -> String {-# NOINLINE blameMessage #-} blameMessage blamed = "Contract failed and the following is to blame:\n " ++ Show.Pretty.ppShow blamed 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 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 {-# NOINLINE showFailure #-} showFailure s v = "Internal failure occurred and the following is to blame:\n " ++ s ++ "\n " ++ Show.Pretty.ppShow v 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 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 v = (s, v) -- | 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 a => (a -> Bool) -> [a] -> Bool {-# INLINE allB #-} allB predicate l = blame (all predicate l) $ allBMessage predicate l allBMessage :: Show a => (a -> Bool) -> [a] -> String {-# NOINLINE allBMessage #-} allBMessage predicate l = Show.Pretty.ppShow (filter (not . predicate) l) ++ " in the context of " ++ Show.Pretty.ppShow l 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