git.iko.soy/vty
on dc8be4e help sign in
vty/test/Verify.hs
91 lines 2.6 kB history raw
1{-# LANGUAGE GADTs #-}
2{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE CPP #-}
5{-# LANGUAGE TypeSynonymInstances #-}
6{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE StandaloneDeriving #-}
8{-# LANGUAGE DisambiguateRecordFields #-}
9{-# LANGUAGE NamedFieldPuns #-}
10module Verify ( module Verify
11 , module Control.DeepSeq
12 , module Test.QuickCheck
13 , succeeded
14 , failed
15 , result
16 , monadicIO
17 , liftIO
18 , liftBool
19 , Test(..)
20 , Prop.Result(..)
21 )
22 where
24import Distribution.TestSuite hiding ( Result(..) )
25import qualified Distribution.TestSuite as TS
27import Test.QuickCheck hiding ( Result(..) )
28import qualified Test.QuickCheck as QC
29import Test.QuickCheck.Property hiding ( Result(..) )
30import qualified Test.QuickCheck.Property as Prop
31import Test.QuickCheck.Monadic ( monadicIO )
33import qualified Codec.Binary.UTF8.String as UTF8
35import Control.DeepSeq
36import Control.Monad.State.Strict
38import Data.IORef
39import Data.Word
41import Numeric ( showHex )
43import System.IO
44import System.Random
46verify :: Testable t => String -> t -> Test
47verify test_name p = Test $ TestInstance
48 { name = test_name
49 , run = do
50 qc_result <- quickCheckResult p
51 case qc_result of
52 QC.Success {..} -> return $ Finished TS.Pass
53 _ -> return $ Finished $ TS.Fail "TODO(corey): add failure message"
54 , tags = []
55 , options = []
56 , setOption = \_ _ -> Left "no options supported"
57 }
59data SingleColumnChar = SingleColumnChar Char
60 deriving (Show, Eq)
62instance Arbitrary SingleColumnChar where
63 arbitrary = elements $ map SingleColumnChar [toEnum 0x21 .. toEnum 0x7E]
65data DoubleColumnChar = DoubleColumnChar Char
66 deriving (Eq)
68instance Show DoubleColumnChar where
69 show (DoubleColumnChar c) = "(0x" ++ showHex (fromEnum c) "" ++ ") ->" ++ UTF8.encodeString [c]
71instance Arbitrary DoubleColumnChar where
72 arbitrary = elements $ map DoubleColumnChar $
73 [ toEnum 0x3040 .. toEnum 0x3098 ]
74 ++ [ toEnum 0x309B .. toEnum 0xA4CF ]
76liftIOResult :: Testable prop => IO prop -> Property
77liftIOResult = morallyDubiousIOProperty
79#if __GLASGOW_HASKELL__ <= 701
80instance Random Word where
81 random g =
82 let (i :: Int, g') = random g
83 in (toEnum i, g')
84 randomR (l,h) g =
85 let (i :: Int, g') = randomR (fromEnum l,fromEnum h) g
86 in (toEnum i, g')
87#endif
89data Bench where
90 Bench :: forall v . NFData v => IO v -> (v -> IO ()) -> Bench