packages feed

yaya-hedgehog 0.2.0.1 → 0.2.1.2

raw patch · 7 files changed

+474/−94 lines, 7 filesdep +doctestdep +yaya-hedgehogdep ~basebuild-type:Customsetup-changed

Dependencies added: doctest, yaya-hedgehog

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,34 +1,55 @@ # Changelog-All notable changes to this project will be documented in this file. +This file documents all notable changes to this package.+ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.2.0.2 – 2023–12–21++### Changed++- updated formatting for newer Ormolu+ ## 0.2.0.1 – 2020–05–18+ ### Changed+ - Turned on StrictData  ## 0.2.0.0 – 2020–05–14+ ### Changed-- updated in sync with polykinding changes in yaya-0.3.0.0 +- updated in sync with polykind changes in yaya-0.3.0.0+ ## 0.1.2.2 – 2020–05–14+ ### Changed+ - enabled and fixed warnings  ## 0.1.2.1 – 2019–11–08+ ### Changed+ - improved documentation  ## 0.1.2.0 – 2019–11–08+ ### Added+ - `law_cataCompose`  ## 0.1.1.0 – 2019–01–08+ ### Added+ - `law_anaRefl` as dual to `law_cataRefl` - lower bounds on internal yaya dependencies  ## 0.1.0.0 – 2019–01–04+ ### Added+ - everything (this is the initial release)
+ Setup.hs view
@@ -0,0 +1,17 @@+-- __NB__: `custom-setup` doesn’t have any way to specify extensions, so any we+--         want need to be specified here.+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE Unsafe #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -Weverything #-}+-- Warns even when `Unsafe` is explicit, not inferred. See+-- https://gitlab.haskell.org/ghc/ghc/-/issues/16689+{-# OPTIONS_GHC -Wno-unsafe #-}++module Main (main) where++import safe "base" System.IO (IO)+import "cabal-doctest" Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctests"
+ src/Yaya/Hedgehog.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE Unsafe #-}++module Yaya.Hedgehog+  ( evalNonterminating,+    nonterminatingProperty,+  )+where++import safe "base" Control.Category (Category ((.)))+import safe "base" Control.Monad ((<=<))+import safe "base" Control.Monad.IO.Class (MonadIO)+import safe "base" Data.Function (const)+import safe "base" Data.Maybe (maybe)+import "base" GHC.IO (evaluate)+import safe "base" GHC.Stack (HasCallStack)+import safe "base" System.Timeout (timeout)+import safe "base" Text.Show (Show)+import qualified "hedgehog" Hedgehog as HH++-- | Returns success if the expression doesn’t terminate, failure otherwise.+--   Termination is just checked with a 1 second timeout, so this isn’t+--   foolproof.+evalNonterminating ::+  (HasCallStack, MonadIO m, HH.MonadTest m, Show a) => a -> m ()+evalNonterminating =+  maybe HH.success (const HH.failure <=< HH.annotateShow)+    <=< HH.evalIO . timeout 1_000_000 . evaluate++-- | Returns success if the expression doesn’t terminate, failure otherwise.+--   The value passed here should termina+nonterminatingProperty :: (HasCallStack, Show a) => a -> HH.Property+nonterminatingProperty = HH.withTests 1 . HH.property . evalNonterminating
src/Yaya/Hedgehog/Expr.hs view
@@ -1,24 +1,40 @@-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE StrictData #-} {-# LANGUAGE TemplateHaskell #-}--module Yaya.Hedgehog.Expr where+{-# LANGUAGE Unsafe #-} -import           Data.Eq.Deriving-import           Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import           Text.Show.Deriving+module Yaya.Hedgehog.Expr+  ( Expr (Add, Lit, Mult),+    expression,+    genCofixExpr,+    genExpr,+    genExprLit,+    genExprOp,+    genFixExpr,+    genMuExpr,+    genNuExpr,+  )+where -import Yaya.Fold-import Yaya.Fold.Native-import Yaya.Hedgehog.Fold+import safe "base" Control.Applicative (Applicative ((<*>)))+import safe "base" Data.Eq (Eq)+import safe "base" Data.Foldable (Foldable)+import safe "base" Data.Functor (Functor, (<$>))+import safe "base" Data.Int (Int)+import safe "base" Data.Traversable (Traversable)+import safe "base" Text.Show (Show)+import safe "deriving-compat" Data.Eq.Deriving (deriveEq1)+import safe "deriving-compat" Text.Show.Deriving (deriveShow1)+import safe "hedgehog" Hedgehog (Gen, Size)+import safe qualified "hedgehog" Hedgehog.Gen as Gen+import safe qualified "hedgehog" Hedgehog.Range as Range+import safe "yaya" Yaya.Fold (Mu, Nu, Steppable)+import safe "yaya" Yaya.Fold.Native (Cofix, Fix)+import safe "this" Yaya.Hedgehog.Fold (embeddableOfHeight)  data Expr a   = Lit Int   | Add a a   | Mult a a-  deriving (Eq, Show, Functor, Foldable, Traversable)+  deriving stock (Eq, Show, Functor, Foldable, Traversable)  deriveEq1 ''Expr deriveShow1 ''Expr@@ -32,7 +48,7 @@ genExpr :: Gen a -> Gen (Expr a) genExpr a = Gen.frequency [(3, genExprLit), (2, genExprOp a)] -expression :: Steppable (->) t Expr => Size -> Gen t+expression :: (Steppable (->) t Expr) => Size -> Gen t expression = embeddableOfHeight genExprLit genExpr  genMuExpr :: Size -> Gen (Mu Expr)@@ -43,3 +59,6 @@  genFixExpr :: Size -> Gen (Fix Expr) genFixExpr = expression++genCofixExpr :: Size -> Gen (Cofix Expr)+genCofixExpr = expression
src/Yaya/Hedgehog/Fold.hs view
@@ -1,46 +1,111 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE Unsafe #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} -module Yaya.Hedgehog.Fold where+module Yaya.Hedgehog.Fold+  ( corecursiveIsUnsafe,+    embeddableOfHeight,+    genAlgebra,+    genCorecursive,+    law_anaRefl,+    law_cataCancel,+    law_cataCompose,+    law_cataRefl,+    recursiveIsUnsafe,+  )+where -import           Control.Arrow-import           Data.Proxy-import           Data.Void-import           Hedgehog-import           Numeric.Natural+import safe "base" Control.Category (Category ((.)))+import safe "base" Data.Bifunctor (Bifunctor (bimap, first))+import safe "base" Data.Eq (Eq)+import safe "base" Data.Function (($))+import safe "base" Data.Functor (Functor (fmap))+import safe "base" Data.Proxy (Proxy (Proxy))+import safe qualified "base" Data.Tuple as Tuple+import safe "base" Data.Void (Void, absurd)+import safe "base" Numeric.Natural (Natural)+import safe "base" Text.Show (Show)+import "hedgehog" Hedgehog+  ( Gen,+    MonadTest,+    Property,+    Size,+    property,+    withTests,+    (===),+  )+import "yaya" Yaya.Fold+  ( Algebra,+    Corecursive (ana),+    Projectable (project),+    Recursive (cata),+    Steppable (embed),+  )+import safe "yaya" Yaya.Fold.Common (diagonal)+import safe "yaya" Yaya.Fold.Native ()+import safe "yaya" Yaya.Pattern (Maybe, Pair ((:!:)), fst, maybe, uncurry)+import "this" Yaya.Hedgehog (evalNonterminating)+import safe "base" Prelude (fromIntegral) -import           Yaya.Fold-import           Yaya.Fold.Native ()+{-# HLINT ignore "Use camelCase" #-} -law_cataCancel-  :: (Eq a, Show a, Steppable (->) t f, Recursive (->) t f, Functor f, MonadTest m)-  => Algebra (->) f a -> f t -> m ()-law_cataCancel φ = uncurry (===) . (cata φ . embed &&& φ . fmap (cata φ))+law_cataCancel ::+  ( Eq a,+    Show a,+    Steppable (->) t f,+    Recursive (->) t f,+    Functor f,+    MonadTest m+  ) =>+  Algebra (->) f a ->+  f t ->+  m ()+law_cataCancel φ =+  uncurry (===) . bimap (cata φ . embed) (φ . fmap (cata φ)) . diagonal -law_cataRefl-  :: (Eq t, Show t, Steppable (->) t f, Recursive (->) t f, MonadTest m) => t -> m ()-law_cataRefl = uncurry (===) . (cata embed &&& id)+law_cataRefl ::+  (Eq t, Show t, Steppable (->) t f, Recursive (->) t f, MonadTest m) =>+  t ->+  m ()+law_cataRefl = uncurry (===) . first (cata embed) . diagonal  -- | NB: Since this requires both a `Corecursive` and `Eq` instance on the same --       type, it _likely_ requires instances from yaya-unsafe.-law_anaRefl-  :: (Eq t, Show t, Steppable (->) t f, Corecursive (->) t f, MonadTest m) => t -> m ()-law_anaRefl = uncurry (===) . (ana project &&& id)+law_anaRefl ::+  (Eq t, Show t, Steppable (->) t f, Corecursive (->) t f, MonadTest m) =>+  t ->+  m ()+law_anaRefl = uncurry (===) . first (ana project) . diagonal --- law_cataFusion---   :: (Eq a, Show a, Recursive (->) t f, Functor f, MonadTest m)---   => (a -> a) -> Algebra (->) f a -> f a -> t -> m ()+-- law_cataFusion ::+--   (Eq a, Show a, Recursive (->) t f, Functor f, MonadTest m) =>+--   (a -> a) ->+--   Algebra (->) f a ->+--   f a ->+--   t ->+--   m () -- law_cataFusion f φ fa t =---       uncurry (==) ((f . φ &&& φ . fmap f) fa)---   ==> uncurry (===) ((f . cata φ &&& cata φ) t)+--   uncurry (==) (bimap (f . φ) (φ . fmap f) $ diagonal fa)+--     ==> uncurry (===) (bimap (f . cata φ) (cata φ) $ diagonal t) -law_cataCompose-  :: forall t f u g m b-   . (Eq b, Show b, Recursive (->) t f, Steppable (->) u g, Recursive (->) u g, MonadTest m)-  => Proxy u -> Algebra (->) g b -> (forall a. f a -> g a) -> t -> m ()-law_cataCompose _ φ ε =-  uncurry (===) . (cata φ . cata (embed . ε :: f u -> u) &&& cata (φ . ε))+law_cataCompose ::+  forall t f u g m b.+  ( Eq b,+    Show b,+    Recursive (->) t f,+    Steppable (->) u g,+    Recursive (->) u g,+    MonadTest m+  ) =>+  Proxy u ->+  Algebra (->) g b ->+  (forall a. f a -> g a) ->+  t ->+  m ()+law_cataCompose Proxy φ ε =+  uncurry (===)+    . bimap (cata φ . cata (embed . ε :: f u -> u)) (cata (φ . ε))+    . diagonal  -- | Creates a generator for any `Steppable` type whose pattern functor has --   terminal cases (e.g., not `Data.Functor.Identity` or `((,) a)`). @leaf@ can@@ -65,19 +130,70 @@ -- --  NB: Hedgehog’s `Size` is signed, so this can raise an exception if given a --      negative `Size`.-embeddableOfHeight-  :: (Steppable (->) t f, Functor f)-  => Gen (f Void) -> (Gen t -> Gen (f t)) -> Size -> Gen t+embeddableOfHeight ::+  (Steppable (->) t f, Functor f) =>+  Gen (f Void) ->+  (Gen t -> Gen (f t)) ->+  Size ->+  Gen t embeddableOfHeight leaf branch size =   cata (genAlgebra leaf branch) (fromIntegral size :: Natural)  -- | Builds a generic tree generator of a certain height.-genAlgebra-  :: (Steppable (->) t f, Functor f)-  => Gen (f Void) -> (Gen t -> Gen (f t)) -> Algebra (->) Maybe (Gen t)+genAlgebra ::+  (Steppable (->) t f, Functor f) =>+  Gen (f Void) ->+  (Gen t -> Gen (f t)) ->+  Algebra (->) Maybe (Gen t) genAlgebra leaf branch =   maybe (fmap (embed . fmap absurd) leaf) (fmap embed . branch)  -- | Creates a generator for potentially-infinite values.-genCorecursive :: Corecursive (->) t f => (a -> f a) -> Gen a -> Gen t+genCorecursive :: (Corecursive (->) t f) => (a -> f a) -> Gen a -> Gen t genCorecursive = fmap . ana++-- | Show that using a `Recursive` structure corecursively can lead to+--   non-termination.+corecursiveIsUnsafe ::+  forall t a.+  ( Corecursive (->) (t (Pair a)) (Pair a),+    Projectable (->) (t (Pair a)) (Pair a),+    Corecursive (->) (t ((,) a)) ((,) a),+    Projectable (->) (t ((,) a)) ((,) a),+    Eq a,+    Show a+  ) =>+  Proxy t ->+  a ->+  Property+corecursiveIsUnsafe Proxy x =+  withTests 1 . property $ do+    -- a properly-finite data structure will diverge on infinite unfolding+    evalNonterminating . fst . project @_ @(t (Pair a)) $ ana (\y -> y :!: y) x+    -- but using a lazy functor loses this property+    Tuple.fst (project @_ @(t ((,) a)) $ ana (\y -> (y, y)) x) === x++-- | Show that using a `Corecursive` structure recursively can lead to+--   non-termination.+recursiveIsUnsafe ::+  forall t a.+  ( Corecursive (->) (t (Pair a)) (Pair a),+    Projectable (->) (t (Pair a)) (Pair a),+    Recursive (->) (t (Pair a)) (Pair a),+    Corecursive (->) (t ((,) a)) ((,) a),+    Recursive (->) (t ((,) a)) ((,) a),+    Eq a,+    Show a+  ) =>+  Proxy t ->+  a ->+  Property+recursiveIsUnsafe Proxy x =+  withTests 1 . property $ do+    -- We can easily get the first element of a corecursive infinite sequence+    fst (project $ ana @_ @(t (Pair a)) (\y -> y :!: y) x) === x+    -- Of course, you can’t fold it.+    evalNonterminating . cata fst $ ana @_ @(t (Pair a)) (\y -> y :!: y) x+    -- But again, if you use a lazy functor, you lose that property, and you can+    -- short-circuit.+    cata Tuple.fst (ana @_ @(t ((,) a)) (\y -> (y, y)) x) === x
+ tests/doctests.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE Unsafe #-}++module Main (main) where++import "base" Data.Function (($))+import "base" Data.Semigroup (Semigroup ((<>)))+import "base" System.IO (IO)+import "doctest" Test.DocTest (doctest)+import "this" Build_doctests (flags, module_sources, pkgs)++main :: IO ()+main = doctest $ flags <> pkgs <> module_sources
yaya-hedgehog.cabal view
@@ -1,43 +1,206 @@-name:                yaya-hedgehog-version:             0.2.0.1-synopsis:            Hedgehog testing support for the Yaya recursion scheme-                     library.-description:         If you use Yaya in your own code and have tests written-                     using Hedgehog, then this library will help you with-                     generating trees, verifying type class instances, etc.-homepage:            https://github.com/sellout/yaya#readme-author:              Greg Pfeil-maintainer:          greg@technomadic.org-copyright:           2017 Greg Pfeil-license:             AGPL-3-license-file:        LICENSE-category:            Recursion-build-type:          Simple-extra-source-files:  CHANGELOG.md-                   , README.md-cabal-version:       >=1.10+cabal-version:  3.0 -library-  hs-source-dirs:      src-  exposed-modules:     Yaya.Hedgehog.Expr-                     , Yaya.Hedgehog.Fold-  build-depends:       base >= 4.7 && < 5-                     , deriving-compat-                     , hedgehog-                     , yaya >= 0.3.0-  default-extensions:  ConstraintKinds-                     , DeriveTraversable-                     , FlexibleContexts-                     , FlexibleInstances-                     , FunctionalDependencies-                     , LambdaCase-                     , MultiParamTypeClasses-                     , RankNTypes-                     , ScopedTypeVariables-                     , StrictData-                     , TupleSections-  default-language:    Haskell2010+name:        yaya-hedgehog+version:     0.2.1.2+synopsis:    Hedgehog testing support for the Yaya recursion scheme+             library.+description: If you use Yaya in your own code and have tests written+             using Hedgehog, then this library will help you with+             generating trees, verifying type class instances, etc.+author:      Greg Pfeil <greg@technomadic.org>+maintainer:  Greg Pfeil <greg@technomadic.org>+copyright:   2017 Greg Pfeil+homepage:    https://github.com/sellout/yaya#readme+bug-reports: https://github.com/sellout/yaya/issues+category:    Recursion+build-type:  Custom+license:     AGPL-3.0-or-later+license-files:+  LICENSE+extra-source-files:+  CHANGELOG.md+  README.md+tested-with:+  GHC == {+--  GHCup   Nixpkgs+    8.6.1,+    8.8.1,  8.8.4,+    8.10.1,+    9.0.1,+    9.2.1,+    9.4.1,  9.4.8,+    9.6.1,+            9.8.1+  }  source-repository head-  type:     git+  type: git   location: https://github.com/sellout/yaya++-- This mimics the GHC2021 extension+-- (https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/control.html?highlight=doandifthenelse#extension-GHC2021),+-- but supporting compilers back to GHC 7.10. If the oldest supported compiler+-- is GHC 9.2, then this stanza can be removed and `import: GHC2021` can be+-- replaced by `default-language: GHC2021`.+common GHC2021+  default-language: Haskell2010+  default-extensions:+    BangPatterns+    BinaryLiterals+    ConstraintKinds+    DeriveDataTypeable+    DeriveGeneric+    -- DeriveLift -- uncomment if the oldest supported version is GHC 8.10.1++    DeriveTraversable+    DerivingStrategies+    DoAndIfThenElse+    EmptyCase+    ExistentialQuantification+    FlexibleContexts+    FlexibleInstances+    GADTSyntax+    GeneralizedNewtypeDeriving+    HexFloatLiterals+    -- ImportQualifiedPost -- uncomment if the oldest supported version is GHC 8.10.1++    InstanceSigs+    LambdaCase+    MagicHash+    MonadComprehensions+    MonomorphismRestriction+    MultiParamTypeClasses+    NamedFieldPuns+    NamedWildCards+    NumericUnderscores+    PolyKinds+    PostfixOperators+    RankNTypes+    ScopedTypeVariables+    StandaloneDeriving+    -- StandaloneKindSignatures -- uncomment if the oldest supported version is GHC 8.10.1++    TupleSections+    TypeApplications+    TypeOperators+    UnicodeSyntax+    NoExplicitNamespaces++common defaults+  import: GHC2021+  build-depends:+    base ^>= {4.12.0, 4.13.0, 4.14.0, 4.15.0, 4.16.0, 4.17.0, 4.18.0, 4.19.0},+  ghc-options:+    -Weverything+    -- Type inference good.+    -Wno-missing-local-signatures+    -- Warns even when `Unsafe` is explicit, not inferred. See+    -- https://gitlab.haskell.org/ghc/ghc/-/issues/16689+    -Wno-unsafe+    -- TODO: prune these warnings+    -Wno-all-missed-specialisations+    -fpackage-trust+    -trust base+  if impl(ghc < 8.8.1)+    ghc-options:+      -- This used to warn even when `Safe` was explicit.+      -Wno-safe+  if impl(ghc >= 8.10.1)+    ghc-options:+      -- If we didn’t allow inferred-safe imports, nothing would be `Safe`.+      -Wno-inferred-safe-imports+      -- We support GHC versions without qualified-post.+      -Wno-prepositive-qualified-module+      -- `-trust` triggers this warning when applied to transitive dependencies.+      -Wno-unused-packages+  if impl(ghc >= 9.2.1)+    ghc-options:+      -- We support GHC versions without kind signatures.+      -Wno-missing-kind-signatures+  if impl(ghc >= 9.8.1)+    ghc-options:+      -- We support GHC versions without kind signatures.+      -Wno-missing-poly-kind-signatures+      -- Inference good.+      -Wno-missing-role-annotations+  default-extensions:+    DefaultSignatures+    ExplicitNamespaces+    FunctionalDependencies+    LiberalTypeSynonyms+    -- replace with `LexicalNegation` if the oldest supported version is GHC 9.0.1++    NegativeLiterals+    PackageImports+    ParallelListComp+    -- QualifiedDo - uncomment if the oldest supported version is GHC 9.0.1++    RecursiveDo+    -- RequiredTypeArguments - uncomment if the oldest supported version is GHC 9.10.1++    RoleAnnotations+    StrictData+    TemplateHaskellQuotes+    TransformListComp+    NoGeneralizedNewtypeDeriving+    NoImplicitPrelude+    NoMonomorphismRestriction+    NoPatternGuards+    NoTypeApplications++custom-setup+  setup-depends:+    -- TODO: Remove `Cabal` dep once haskell/cabal#3751 is fixed.+    Cabal ^>= {3.0.0, 3.2.0, 3.4.0, 3.6.0, 3.8.0, 3.10.0},+    base ^>= {4.12.0, 4.13.0, 4.14.0, 4.15.0, 4.16.0, 4.17.0, 4.18.0, 4.19.0},+    cabal-doctest ^>= 1.0.0++library+  import: defaults+  hs-source-dirs:+    src+  exposed-modules:+    Yaya.Hedgehog+    Yaya.Hedgehog.Expr+    Yaya.Hedgehog.Fold+  build-depends:+    deriving-compat,+    hedgehog,+    yaya >= 0.3.0,+  ghc-options:+    -trust adjunctions+    -trust array+    -trust base-orphans+    -trust binary+    -trust bytestring+    -trust containers+    -trust distributive+    -trust exceptions+    -trust ghc-prim+    -trust profunctors+    -trust semigroupoids+    -trust stm+    -trust text+    -trust transformers-compat+  if impl(ghc < 9.6)+    ghc-options:+      -trust foldable1-classes-compat++test-suite doctests+  import: defaults+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: doctests.hs+  build-depends:+    doctest ^>= {0.15.0, 0.16.0, 0.17.0, 0.18.0, 0.19.0, 0.20.0, 0.21.0, 0.22.0},+    yaya-hedgehog,+  -- TODO: The sections below here are necessary because we don’t have control+  --       over the generated `Build_doctests.hs` file. So we have to silence+  --       all of its warnings one way or another.+  ghc-options:+    -Wno-missing-export-lists+    -Wno-missing-import-lists+    -Wno-safe+  if impl(ghc >= 8.8.1)+    ghc-options:+      -- This used to warn even when `Safe` was explicit.+      -Wno-missing-deriving-strategies+  default-extensions:+    -- Since we can’t add `{-# LANGUAGE Safe -#}` to the generated+    -- “Build_doctests.hs”, we set it here, and that means it has to match+    -- doctests.hs, which is `Unsafe`.+    Unsafe