module Test.Ganeti.Query.Language
( testQuery_Language
, genFilter
, genJSValue
) where
import Test.HUnit (Assertion, assertEqual)
import Test.QuickCheck
import Control.Arrow (second)
import Text.JSON
import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Ganeti.JSON
import Ganeti.Query.Language
instance Arbitrary (Filter FilterField) where
arbitrary = genFilter
genFilter :: Gen (Filter FilterField)
genFilter = choose (0, 10) >>= genFilter'
genFilter' :: Int -> Gen (Filter FilterField)
genFilter' 0 =
oneof [ pure EmptyFilter
, TrueFilter <$> genName
, EQFilter <$> genName <*> value
, LTFilter <$> genName <*> value
, GTFilter <$> genName <*> value
, LEFilter <$> genName <*> value
, GEFilter <$> genName <*> value
, RegexpFilter <$> genName <*> arbitrary
, ContainsFilter <$> genName <*> value
]
where value = oneof [ QuotedString <$> genName
, NumericValue <$> arbitrary
]
genFilter' n =
oneof [ AndFilter <$> vectorOf n'' (genFilter' n')
, OrFilter <$> vectorOf n'' (genFilter' n')
, NotFilter <$> genFilter' n'
]
where n' = n `div` 2
n'' = max n' 2
$(genArbitrary ''QueryTypeOp)
$(genArbitrary ''QueryTypeLuxi)
$(genArbitrary ''ItemType)
instance Arbitrary FilterRegex where
arbitrary = genName >>= mkRegex
$(genArbitrary ''ResultStatus)
$(genArbitrary ''FieldType)
$(genArbitrary ''FieldDefinition)
genJSValue :: Gen JSValue
genJSValue =
oneof [ JSBool <$> arbitrary
, JSRational <$> pure False <*> arbitrary
, JSString <$> (toJSString <$> arbitrary)
, (JSArray . map showJSON) <$> (arbitrary::Gen [Int])
, JSObject . toJSObject . map (second showJSON) <$>
(arbitrary::Gen [(String, Int)])
]
genResultEntry :: Gen ResultEntry
genResultEntry = do
rs <- arbitrary
rv <- case rs of
RSNormal -> Just <$> genJSValue
_ -> pure Nothing
return $ ResultEntry rs rv
$(genArbitrary ''QueryFieldsResult)
prop_filter_serialisation :: Property
prop_filter_serialisation = forAll genFilter testSerialisation
prop_filterregex_instances :: FilterRegex -> Property
prop_filterregex_instances rex =
counterexample "failed JSON encoding" (testSerialisation rex)
prop_resultstatus_serialisation :: ResultStatus -> Property
prop_resultstatus_serialisation = testSerialisation
prop_fieldtype_serialisation :: FieldType -> Property
prop_fieldtype_serialisation = testSerialisation
prop_fielddef_serialisation :: FieldDefinition -> Property
prop_fielddef_serialisation = testSerialisation
prop_resultentry_serialisation :: Property
prop_resultentry_serialisation = forAll genResultEntry testSerialisation
prop_fieldsresult_serialisation :: Property
prop_fieldsresult_serialisation =
forAll (resize 20 arbitrary::Gen QueryFieldsResult) testSerialisation
prop_itemtype_serialisation :: ItemType -> Property
prop_itemtype_serialisation = testSerialisation
case_filterParsing :: Assertion
case_filterParsing = do
let check :: String -> Filter String -> Assertion
check str expected = do
jsval <- fromJResult "could not parse filter" $ decode str
assertEqual str expected jsval
val = QuotedString "val"
valRegex <- mkRegex "val"
check "null" EmptyFilter
check "[\"&\", null, null]" $ AndFilter [EmptyFilter, EmptyFilter]
check "[\"|\", null, null]" $ OrFilter [EmptyFilter, EmptyFilter]
check "[\"!\", null]" $ NotFilter EmptyFilter
check "[\"?\", \"field\"]" $ TrueFilter "field"
check "[\"==\", \"field\", \"val\"]" $ EQFilter "field" val
check "[\"<\", \"field\", \"val\"]" $ LTFilter "field" val
check "[\">\", \"field\", \"val\"]" $ GTFilter "field" val
check "[\"<=\", \"field\", \"val\"]" $ LEFilter "field" val
check "[\">=\", \"field\", \"val\"]" $ GEFilter "field" val
check "[\"=~\", \"field\", \"val\"]" $ RegexpFilter "field" valRegex
check "[\"=[]\", \"field\", \"val\"]" $ ContainsFilter "field" val
check "[\"=\", \"field\", \"val\"]" $ EQFilter "field" val
check "[\"!=\", \"field\", \"val\"]" $ NotFilter (EQFilter "field" val)
testSuite "Query/Language"
[ 'prop_filter_serialisation
, 'prop_filterregex_instances
, 'prop_resultstatus_serialisation
, 'prop_fieldtype_serialisation
, 'prop_fielddef_serialisation
, 'prop_resultentry_serialisation
, 'prop_fieldsresult_serialisation
, 'prop_itemtype_serialisation
, 'case_filterParsing
]