refined 0.4.2.2 → 0.4.3

raw patch · 5 files changed

+110/−6 lines, 5 filesdep ~QuickCheckdep ~base

Dependency ranges changed: QuickCheck, base

Files

• refined.cabal +11/−1
• src/Refined.hs +1/−0
• src/Refined/Internal.hs +10/−1
• src/Refined/Orphan/QuickCheck.hs +41/−4
• test/QuickCheck.hs +47/−0

@@ -3,7 +3,7 @@ name:   refined version:-  0.4.2.2+  0.4.3 synopsis:   Refinement types with static and runtime checking description:@@ -94,4 +94,14 @@       base     , refined     , doctest >= 0.10+  default-language: Haskell2010++test-suite arbitrary+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: QuickCheck.hs+  build-depends:+      base+    , refined+    , QuickCheck   default-language: Haskell2010

@@ -68,6 +68,7 @@      -- * 'Predicate'   , Predicate (validate)+  , reifyPredicate      -- * Logical predicates   , Not(..)

@@ -32,6 +32,7 @@  -------------------------------------------------------------------------------- +{-# LANGUAGE AllowAmbiguousTypes        #-} {-# LANGUAGE CPP                        #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DeriveFoldable             #-}@@ -81,6 +82,7 @@      -- * 'Predicate'   , Predicate (validate)+  , reifyPredicate      -- * Logical predicates   , Not(..)@@ -373,8 +375,15 @@  -------------------------------------------------------------------------------- +-- | Reify a 'Predicate' by turning it into a value-level predicate.+reifyPredicate :: forall p a. Predicate p a => a -> Bool+reifyPredicate = refine @p @a .> isRight++--------------------------------------------------------------------------------+ -- | A predicate which is satisfied for all types.---   The value is not evaluated by 'validate'.+--   Arguments passed to @'validate'@ in @'validate' 'IdPred' x@+--   are not evaluated. -- --   >>> isRight (refine @IdPred @Int undefined) --   True

@@ -27,8 +27,10 @@  -------------------------------------------------------------------------------- +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP                 #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  -------------------------------------------------------------------------------- @@ -41,13 +43,48 @@ #if HAVE_QUICKCHECK  import           Data.Either      (isRight)-import           Refined.Internal (Refined(Refined), RefineException, Predicate, refine)-import           Test.QuickCheck  (Arbitrary(arbitrary), suchThat, Gen)+import           Refined.Internal (Refined, RefineException, Predicate, refine, reifyPredicate)+import           Refined.Unsafe   (reallyUnsafeRefine)+import           Test.QuickCheck  (Arbitrary(arbitrary), suchThatMaybe, Gen, sized, resize)+import           Data.Typeable    (Typeable, showsTypeRep, typeRep)+import           Data.Proxy       (Proxy(Proxy))  -------------------------------------------------------------------------------- -instance forall p a. (Arbitrary a, Predicate p a) => Arbitrary (Refined p a) where-  arbitrary = Refined <$> suchThat (arbitrary :: Gen a) (isRight . (refine :: a -> Either RefineException (Refined p a)))+instance forall p a. (Arbitrary a, Typeable a, Typeable p, Predicate p a) => Arbitrary (Refined p a) where+  arbitrary = loop 0 arbitrary++loop :: forall p a. (Typeable p, Typeable a, Predicate p a)+  => Int -> Gen a -> Gen (Refined p a)+loop runs gen+  | runs < 100 = do+      m <- suchThatRefined gen+      case m of+        Just x -> do+          pure x+        Nothing -> do+          loop (runs + 1) gen+  | otherwise = error (refinedGenError (Proxy @p) (Proxy @a))++refinedGenError :: (Typeable p, Typeable a)+  => Proxy p -> Proxy a -> String+refinedGenError p a = "arbitrary :: Refined ("+  ++ typeName p+  ++ ") ("+  ++ typeName a+  ++ "): Failed to generate a value that satisfied"+  ++ " the predicate after 100 tries."++suchThatRefined :: forall p a. (Predicate p a)+  => Gen a -> Gen (Maybe (Refined p a))+suchThatRefined gen = do+  m <- suchThatMaybe gen (reifyPredicate @p @a)+  case m of+    Nothing -> pure Nothing+    Just x -> pure (Just (reallyUnsafeRefine x))++typeName :: Typeable a => Proxy a -> String+typeName = flip showsTypeRep "" . typeRep  -------------------------------------------------------------------------------- 

@@ -0,0 +1,47 @@+{-# language+    DataKinds+  , GeneralizedNewtypeDeriving+  , ScopedTypeVariables+  , TypeApplications+  , TypeOperators+  , ViewPatterns+  #-}++module Main (main) where++import Test.QuickCheck+import Refined+import Refined.Orphan++main :: IO ()+main = mapM_ quickCheck+  [ prop_lt+  , prop_gt+  , prop_from+  , prop_to+  , prop_bad+  ]++iddy :: (Eq a) => Refined p a -> Bool+iddy (unrefine -> r) = r == r++prop_lt :: Property+prop_lt = property $ \(r :: Refined (LessThan 5) MyInt) -> iddy r++prop_gt :: Property+prop_gt = property $ \(r :: Refined (GreaterThan 5) MyInt) -> iddy r++prop_from :: Property+prop_from = property $ \(r :: Refined (From 9) MyInt) -> iddy r++prop_to :: Property+prop_to = property $ \(r :: Refined (To 9) MyInt) -> iddy r++prop_bad :: Property+prop_bad = expectFailure $ \(r :: Refined (EqualTo 2 && EqualTo 3) MyInt) -> iddy r++newtype MyInt = MyInt Int+  deriving (Eq, Ord, Show, Num)++instance Arbitrary MyInt where+  arbitrary = MyInt <$> choose (0,100)