assert-failure-0.1.1.0/0000755000000000000000000000000012304656142012766 5ustar0000000000000000assert-failure-0.1.1.0/assert-failure.cabal0000644000000000000000000000431412304656142016702 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.1.0 synopsis: Syntactic sugar improving 'assert' and 'error' description: This library contains syntactic sugar that improves the usability of 'assert' and 'error'. This is actually a bunch of hacks wrapping the original 'assert' function, see inside. . See also , and . 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.4.2, GHC == 7.6.3 extra-source-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 && < 5, text >= 0.11.2.3 && < 2, pretty-show >= 1.6 && < 2 default-language: Haskell2010 default-extensions: MonoLocalBinds, ScopedTypeVariables, BangPatterns, RecordWildCards, NamedFieldPuns other-extensions: OverloadedStrings ghc-options: -Wall -fwarn-orphans -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -fwarn-monomorphism-restriction -fwarn-unrecognised-pragmas ghc-options: -fno-warn-auto-orphans -fno-warn-implicit-prelude ghc-options: -fno-ignore-asserts -funbox-strict-fields assert-failure-0.1.1.0/LICENSE0000644000000000000000000000272412304656142014000 0ustar0000000000000000Copyright (c) 2013, 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.1.0/Setup.hs0000644000000000000000000000005612304656142014423 0ustar0000000000000000import Distribution.Simple main = defaultMain assert-failure-0.1.1.0/README.md0000644000000000000000000000260012304656142014243 0ustar0000000000000000assert-failure [![Build Status](https://secure.travis-ci.org/Mikolaj/assert-failure.png)](http://travis-ci.org/Mikolaj/assert-failure)[![Build Status](https://drone.io/github.com/Mikolaj/assert-failure/status.png)](https://drone.io/github.com/Mikolaj/assert-failure/latest) ============== This library contains syntactic sugar that improves the usability of 'assert' and 'error'. This is actually a bunch of hacks wrapping the original 'assert' function, which is, as of GHC 7.8, the only simple way of obtaining source positions. The original 'assert' function is here re-exported for convenience. See also , and . 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 is available from [Hackage] [1] and it's homepage and issue tracker is on [github] [2]. The library emerged from the tons of assertions (augmented by comments and printouts) and 'error' calls (marked by unique strings to overcome their lack of source position) in the [LambdaHack] [3] game engine. [1]: http://hackage.haskell.org/package/assert-failure [2]: https://github.com/Mikolaj/assert-failure [3]: http://hackage.haskell.org/package/LambdaHack assert-failure-0.1.1.0/Control/0000755000000000000000000000000012304656142014406 5ustar0000000000000000assert-failure-0.1.1.0/Control/Exception/0000755000000000000000000000000012304656142016344 5ustar0000000000000000assert-failure-0.1.1.0/Control/Exception/Assert/0000755000000000000000000000000012304656142017605 5ustar0000000000000000assert-failure-0.1.1.0/Control/Exception/Assert/Sugar.hs0000644000000000000000000001001212304656142021214 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Syntactic sugar that improves the usability of 'Control.Exception.assert' -- and 'error'. -- -- This is actually a bunch of hacks wrapping the original @assert@ function, -- which is, as of GHC 7.8, the only simple way of obtaining source positions. -- 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, failure, twith, swith, allB, skip, forceEither ) where import Control.Exception (assert) import Data.Text (Text) import Debug.Trace (trace) 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 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") 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 `twith` -- | Syntactic sugar for the pair operation, to be used in 'blame' -- and 'failure' as in -- -- > assert (age < 120 `blame` "age too high" `twith` age) $ savings / (120 - age) -- -- or -- -- > case xs of -- > 0 : _ -> assert `failure` "insignificant zero" `twith` xs -- -- Fixing the first component of the pair to @Text@ prevents warnings -- about defaulting. twith :: Text -> b -> (Text, b) {-# INLINE twith #-} twith t b = (t, b) infix 2 `swith` -- | The same as 'twith', but for 'String', not 'Text'. -- -- Syntactic sugar for the pair operation, to be used in 'blame' -- and 'failure' as in -- -- > assert (age < 120 `blame` "age too high" `swith` age) $ savings / (120 - age) -- -- or -- -- > case xs of -- > 0 : _ -> assert `failure` "insignificant zero" `swith` xs -- -- Fixing the first component of the pair to @String@ prevents warnings -- about defaulting. swith :: String -> b -> (String, b) {-# INLINE swith #-} swith t b = (t, b) -- | 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 -- | To be used in place of the verbose @(return ())@, as in -- -- > do k <- getK7 r -- > assert (k <= maxK `blame` "K7 too large" `twith` r) skip -- > return $ k >= averageK skip :: Monad m => m () {-# INLINE skip #-} skip = return () 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. Used as in -- -- > assert `forceEither` parseOrFailWithMessage code forceEither :: Show a => (forall x. Bool -> x -> x) -> Either a b -> b {-# NOINLINE forceEither #-} forceEither asrt (Left a) = asrt `failure` a forceEither _ (Right b) = b