property-matchers (empty) → 0.1.0.0

raw patch · 4 files changed

+422/−0 lines, 4 filesdep +adjunctionsdep +basedep +deepseq

Dependencies added: adjunctions, base, deepseq, pretty-simple, prettyprinter, recover-rtti, semigroups, text

Files

• CHANGELOG.md +67/−0
• LICENSE +30/−0
• property-matchers.cabal +33/−0
• src/PropertyMatchers.hs +292/−0

@@ -0,0 +1,67 @@+# Revision history for predicate-transformers++## 0.17.0.0 -- 2024-10-13+* Rename multiple functions to shorter names with the intent that predicate-transformers be imported qualified.+  In particular `also` renamed to `and`, `otherHand` renamed to `or`, etc.+* Delete `lens` and `mtl` dependencies.+* Delete `soleElementOf`, for lack of use in favor of `match`.+* Rename `Predicatory` to `Boolish` for ease of reading.+* Delete `Exceptional` class, folding it into the newly renamed `Boolish`.+* Delete `predJust`, `predLeft`, and `predRight` in favor of `match` uses.++## 0.16.0.0 -- 2024-10-13+* Add predicate failure error messages that include the actual value under test and a message explaining what was expected.+* Rename `just`, `left`, and `right` to `predJust`, `predLeft`, `predRight`++## 0.15.0.0 -- 2024-08-23+* Change `?` to right associative so that it works with `.`.++## 0.14.0.0 -- 2024-08-23+* Add `?` back in as a useful operator to work with `&`; `&` can be used as a predicate applicator, and `?` can be used as a predicate transformer applicator, allowing for a form of infix binary application like `x & f ? y = f x y`.+* Add `match` back in as a type-restricted alias for `soleElementOf`.++## 0.13.0.0 -- 2024-07-23+* Remove `?`++## 0.12.0.0 -- 2024-07-23+* Rename `sole` to `soleElement`+* Add `?`, an infix function application operator with lower+  precedence than `!`.+* Add `satAll = foldr also continue`.++## 0.11.0.0 -- 2024-07-21+* Add documentation.+* Rename `onlyContains` to `sole`. Add `soleOf`, generalizing over `Fold`s.+  `soleOf` is likely a better replacement for `match` than `allOf1` was.+* Exchange `INLINABLE` pragmas for `-fexpose-all-unfoldings`.+* Implement `traceFailFunShow`.+* Change `Exceptional`'s method `assess` to make it possible to implement for functional predicates, and delete `traceFailFun`, now redundant.++## 0.10.0.0 -- 2024-07-21++* Rename `oneOfTwo` to `otherHand`, for easier reading.+* Set `also` and `otherHand` precedences to those of `&&` and `||`+  respectively. That makes them work better with the precedence of+  `!`, allowing easier composition.+* Rename `only` to `onlyContains`, for easier reading and to avoid a+  name conflict with `Control.Lens.only`.+* Set `!` precedence to be equal to that of `.`.+* Add `equals` predicate.+* Delete `match`. `allOf1` does the same thing more generally, with+  `Fold` instead of `Prism`.+* Make `otherHand` stop catching async exceptions. Otherwise a thread+  being killed may appear as a predicate failure.++## 0.9.0.0 -- 2024-07-21++* Add instance `Predicatory (e -> a)`. This will allow for adding extra+  parameters to predicates, making it easier to compose them; maybe+  these are called "functional predicates".+* Added `traceFailFun`. This version of traceFail works on functional+  predicates.+* Tupling sugar renamed from `==>` to `:=>`, to allow it to be a pattern synonym.+* Minor code style changes.++## 0.1.0.0 -- 2019-10-05++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2019, Edmund Noble++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 Edmund Noble nor the names of other+      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+OWNER 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.

@@ -0,0 +1,33 @@+cabal-version: 2.4++name: property-matchers+version: 0.1.0.0+synopsis: A library for tests, based on transforming and writing properties+description:+  This package provides ways to write properties for testing such that they compose nicely and are easy to debug.+license: BSD-3-Clause+license-file: LICENSE+author: Edmund Noble+maintainer: edmundnoble@gmail.com+category: Data+extra-doc-files: CHANGELOG.md+source-repository head+  type: git+  location: https://gitlab.com/edmundnoble/property-matchers++library+  exposed-modules: PropertyMatchers+  ghc-options: -Wall+  build-depends:+    base >=4.8 && <4.30+   ,adjunctions >= 4.4.2 && < 5+   ,deepseq >= 1.4.8 && < 2+   ,recover-rtti >= 0.3 && < 0.6+   ,pretty-simple >= 1.1 && < 4.2+   ,prettyprinter >= 1.6 && < 2.0+   ,text >= 1.0 && < 2.2+  if !impl(ghc >= 8.0)+    build-depends:+      semigroups >= 0.8.4 && < 1+  hs-source-dirs: src+  default-language: Haskell2010

@@ -0,0 +1,292 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fexpose-all-unfoldings #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE ImportQualifiedPost #-}++-- | This library is based on the notion of a property transformer, the below+-- type @PT a b@, which is a function from @a@ to properties on @b@.+-- They act as a sort of compositional "matcher language".+-- Composing these property transformers is meant to be analogous to composing optics+-- and there are utilities for using property transformers with (lens-style) optics.+--+-- Some property transformers provided by other libraries:+-- `Data.Foldable.all`, `Data.Foldable.any` (base)+-- `either` (base)+-- `Control.Lens.allOf` (lens)+module PropertyMatchers+  ( Boolish(..)+  , PropertyFailed(..)+  , Prop+  , PT+  , endingWith+  , startingWith+  , match+  , atIndex+  , list+  , propful+  , compose+  , allTrue+  , allOf1+  , pattern (:=>)+  , pair+  , fun+  , (?)+  , traced+  , tracedShow+  , traceFailShow+  , traceFail+  , forced+  , equals+  )+  where++import "base" Prelude hiding (and, fail, or)+import "base" Control.Concurrent (myThreadId)+import "base" Control.Exception+import "base" Control.Monad hiding (fail)+import "base" Data.Foldable (toList)+import "base" Data.Functor.Const+import "base" Data.Typeable+import "base" Debug.Trace+import "base" GHC.Conc (pseq)+import "base" GHC.Stack+import "base" System.IO.Unsafe++import "deepseq" Control.DeepSeq (NFData, force)+import "text" Data.Text.Lazy qualified as TL+import "adjunctions" Data.Functor.Rep (Representable (..))++import "pretty-simple" Text.Pretty.Simple qualified as Pretty.Simple+import "prettyprinter" Prettyprinter qualified as PP+import "prettyprinter" Prettyprinter.Render.String qualified as PP+import "recover-rtti" Debug.RecoverRTTI (anythingToString)++type Getting r s a = (a -> Const r a) -> s -> Const r s++-- | Class of possible property results.+-- This is almost a lattice with `or` as disjunction, `and` as conjunction, `fail` as the falsy+-- value, and `succeed` as the truthy value. However there may be multiple falsy values, and+-- `and` will pick the first one it's passed, whereas `or` will pick the second it's passed.+class Boolish a where+  or :: a -> a -> a+  and :: a -> a -> a+  fail :: HasCallStack => PP.Doc ann -> v -> a+  succeed :: a+  -- | Check and execute a callback on failure.+  assess :: a -> IO () -> a+  {-# MINIMAL or, and, fail, succeed, assess #-}++instance Boolish a => Boolish (e -> a) where+  (f `or` f') e = f e `or` f' e+  (f `and` f') e = f e `and` f' e+  fail expected actual = withFrozenCallStack $ \_ -> fail expected actual+  succeed = \_ -> succeed+  assess f act = \e -> assess (f e) act++infixr 3 `and`+infixr 2 `or`++-- | The exception thrown by properties of type `IO ()` by default. Other IOExceptions will work fine.+data PropertyFailed = forall actual ann. PropertyFailed !CallStack (PP.Doc ann) actual+  deriving (Typeable)+instance Show PropertyFailed where+  show = displayException++anythingToTextPretty :: a -> TL.Text+anythingToTextPretty = Pretty.Simple.pStringOpt opts . anythingToString+  where+  opts = Pretty.Simple.defaultOutputOptionsNoColor+    { Pretty.Simple.outputOptionsIndentAmount = 2+    , Pretty.Simple.outputOptionsPageWidth = 120+    , Pretty.Simple.outputOptionsCompact = True+    , Pretty.Simple.outputOptionsCompactParens = True+    , Pretty.Simple.outputOptionsInitialIndent = 0+    }++instance Exception PropertyFailed where+  displayException (PropertyFailed cs expected actual) =+    PP.renderString $ PP.layoutSmart PP.defaultLayoutOptions $+      PP.group+        ( PP.line'+        <> PP.flatAlt "Actual:" "Actual value"+        <> PP.softline <> PP.pretty prettyActual+        <> PP.line' <> PP.line+        <> PP.flatAlt "Expected:" "but expected"+        <> PP.softline <> expected+        )+      <> PP.hardline <> PP.pretty (prettyCallStack cs)+    where+    prettyActual = anythingToTextPretty actual++instance Boolish Bool where+  or = (||)+  and = (&&)+  fail _ _ = False+  succeed = True+  assess b act+    | b = b+    | otherwise = unsafePerformIO act `pseq` b++instance a ~ () => Boolish (IO a) where+  or x y = do+    catches x+      -- explicitly do not handle async exceptions.+      -- otherwise, a thread being killed may appear as a property failure.+      [ Handler $ \(ex :: SomeAsyncException) -> do+        tid <- myThreadId+        throwTo tid ex+      , Handler $ \(_ex :: SomeException) -> y+      ]+  and = (>>)+  fail expected actual = throwIO (PropertyFailed (popCallStack callStack) expected actual)+  succeed = return ()+  assess x act =+    catches x+      -- explicitly do not handle async exceptions.+      -- otherwise, a thread being killed may appear as a property failure.+      [ Handler $ \(ex :: SomeAsyncException) -> do+        tid <- myThreadId+        throwTo tid ex+      , Handler $ \(ex :: SomeException) ->+        act >> throwIO ex+      ]++-- | A convenient alias for properties.+type Prop p a = a -> p++-- | Property transformers form a category where composition is ordinary function composition.+--  Forms a category with `.` and `id`.+--  Multiple are already provided by the standard library,+--  for instance `Data.Foldable.all` and `Data.Foldable.any`.+type PT p a b = Prop p a -> Prop p b++-- | Operate on the last value in a foldable, or fail if it's not present.+endingWith :: (HasCallStack, Boolish p, Foldable f) => PT p a (f a)+endingWith _ actual@(toList -> []) = fail "nonempty foldable" actual+endingWith p (toList -> xs) = p $ last xs++-- | Operate on the first value in a foldable, or fail if it's not present.+startingWith :: (HasCallStack, Boolish p, Foldable f) => PT p a (f a)+startingWith _ actual@(toList -> []) = fail "nonempty foldable" actual+startingWith p (toList -> (x : _)) = p x++-- | Require that a @Prism@ matches, and apply the property to its contents.+-- This works for folds, too.+match+  :: (HasCallStack, Boolish p)+  => Getting [a] s a+  -> PT p a s+match f p s =+  case f (Const . pure) s of+    Const [x] -> p x+    _ -> fail "fold to match" s++-- | Test the element of a foldable at some index.+atIndex :: (Boolish p, Foldable f) => Int -> PT p a (f a)+atIndex k p = startingWith p . drop k . toList++-- | Given a list of properties and a list of values, ensure that each property holds for each respective value.+--  Fails if the two lists have different lengths.+list :: (HasCallStack, Boolish p) => [Prop p a] -> [a] -> p+list ps xs+  | psl == length xs = foldr and succeed (zipWith ($) ps xs)+  | otherwise = fail ("list with length " <> PP.pretty psl) xs+  where+  psl = length ps++-- | Given a functor-full of properties, and a functor-full of values, ensure that the structures+--  of the two functors match and apply all of the properties to all of the values.+--  Generalized version of `list`.+propful ::+  (HasCallStack, Boolish p, Eq (f ()), Functor f, Foldable f) =>+  f (Prop p a) ->+  Prop p (f a)+propful props values+  | void props == void values =+    list (toList props) (toList values)+  | otherwise =+    fail ("shape equal to that of" <> PP.pretty (anythingToTextPretty props)) values++-- | Given a representable functor-full of properties, and a functor-full of values,+--  yield a representable functor-full of booleans. Similar to `propful`.+compose ::+  Representable f =>+  f (Prop p a) ->+  f a ->+  f p+compose pr fa = tabulate (\r -> index pr r $ index fa r)++-- | Test all properties against one value.+allTrue :: (Boolish p, Foldable f) => f (Prop p a) -> Prop p a+allTrue ps a = foldr (\p r -> p a `and` r) succeed ps++-- | Check that a property is true for all values behind a generalized getter+--  and that there's at least one value for which it's true.+allOf1+  :: (HasCallStack, Boolish p)+  => Getting [a] s a+  -> PT p a s+allOf1 g p vs+  | [] <- vsList =+    foldr (\x r -> p x `and` r) succeed vsList+  | otherwise = fail "non-empty for fold" vs+  where+  Const vsList = g (Const . pure) vs++-- | Sugar for tupling.+pattern (:=>) :: a -> b -> (a, b)+pattern a :=> b = (a, b)++-- | A pair of properties, made into a property of pairs.+pair :: Boolish p => Prop p a -> Prop p b -> Prop p (a, b)+pair f s (a, b) = f a `and` s b++-- | Flipped function composition; @pf f@ for a function @f@ is a property transformer+-- such that @pf f p i == p (f i)@.+fun :: (a -> b) -> PT p b a+fun f p = p . f++-- | Higher precedence '$', to work well with '&'.+-- The intended use is something like `x & match _Right ? equals 2`.+(?) :: (a -> b) -> a -> b+(?) = ($)+infixr 8 ?++-- | Prints the input of a property, if the property fails, using `Show`.+--   Requires that the property's output type can be checked for failure.+traceFailShow :: (Boolish p, Show a) => PT p a a+traceFailShow = traceFail show++-- | Prints the input of a property over functions, if the property fails.+--   Requires that the property's output type can be checked for failure.+traceFail :: (Boolish p) => (a -> String) -> PT p a a+traceFail s p a =+  assess (p a) $ traceIO (s a)++-- | Prints the input of a property, for debugging.+traced :: Show a => (a -> String) -> PT c a a+traced s p a = trace (s a) (p a)++-- | Prints the input of a property, for debugging.+tracedShow :: Show a => PT c a a+tracedShow = traced show++-- | Property which triggers full evaluation of its input and succeeds.+--  Useful for testing that an exception isn't thrown.+forced :: (Boolish p, NFData a) => Prop p a+forced a = force a `seq` succeed++-- | The property of being equal to some expected value.+equals :: (HasCallStack, Boolish p, Eq a) => a -> Prop p a+equals expected actual+  | expected == actual = succeed+  | otherwise = fail (PP.pretty (anythingToTextPretty expected)) actual