git.iko.soy/vty
on master help sign in
vty/test/Verify.hs
89 lines 2.7 kB history raw
1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE TypeSynonymInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE StandaloneDeriving #-}
7{-# LANGUAGE DisambiguateRecordFields #-}
8{-# LANGUAGE NamedFieldPuns #-}
9module Verify
10 ( module Verify
11 , module Control.Applicative
12 , module Control.DeepSeq
13 , module Control.Exception
14 , module Control.Monad
15 , module Test.QuickCheck
16 , module Test.QuickCheck.Modifiers
17 , module Text.Printf
18 , succeeded
19 , failed
20 , monadicIO
21 , liftIO
22 , liftBool
23 , Test(..)
24 , Prop.Result(..)
25 )
26where
28import Control.Exception ( bracket, try, SomeException(..) )
30import Distribution.TestSuite hiding ( Result(..) )
31import qualified Distribution.TestSuite as TS
33import Test.QuickCheck hiding ( Result(..) )
34import qualified Test.QuickCheck as QC
35import Test.QuickCheck.Modifiers
36import Test.QuickCheck.Property hiding ( Result(..) )
37import qualified Test.QuickCheck.Property as Prop
38import Test.QuickCheck.Monadic ( monadicIO )
40import Text.Printf
42import qualified Codec.Binary.UTF8.String as UTF8
44import Control.Applicative hiding ( (<|>) )
45import Control.DeepSeq
46import Control.Monad ( forM, mapM, mapM_, forM_ )
47import Control.Monad.State.Strict
49import Numeric ( showHex )
51verify :: Testable t => String -> t -> Test
52verify testName p = Test $ TestInstance
53 { name = testName
54 , run = do
55 qcResult <- quickCheckWithResult (stdArgs {chatty = False}) p
56 case qcResult of
57 QC.Success {..} -> return $ Finished TS.Pass
58 QC.Failure {numShrinks,reason} -> return $ Finished
59 $ TS.Fail $ "After "
60 ++ show numShrinks ++ " shrinks determined failure to be: "
61 ++ show reason
62 _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"
63 , tags = []
64 , options = []
65 , setOption = \_ _ -> Left "no options supported"
66 }
68data SingleColumnChar = SingleColumnChar Char
69 deriving (Show, Eq)
71instance Arbitrary SingleColumnChar where
72 arbitrary = elements $ map SingleColumnChar [toEnum 0x21 .. toEnum 0x7E]
74data DoubleColumnChar = DoubleColumnChar Char
75 deriving (Eq)
77instance Show DoubleColumnChar where
78 show (DoubleColumnChar c) = "(0x" ++ showHex (fromEnum c) "" ++ ") ->" ++ UTF8.encodeString [c]
80instance Arbitrary DoubleColumnChar where
81 arbitrary = elements $ map DoubleColumnChar $
82 [ toEnum 0x3040 .. toEnum 0x3098 ]
83 ++ [ toEnum 0x309B .. toEnum 0xA4CF ]
85liftIOResult :: Testable prop => IO prop -> Property
86liftIOResult = ioProperty
88data Bench where
89 Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench