@@ -15,60 +15,6 @@ import Test.QuickCheck
1515import qualified Data.ByteString.Char8 as B
1616import Data.Time
1717import Control.Monad.Reader
18−arbitrary' :: AtomType -> WithTCMap Gen (Either RelationalError Atom)
19−arbitrary' IntegerAtomType =
20− Right . IntegerAtom <$> lift (arbitrary :: Gen Integer)
21−
22−arbitrary' (RelationAtomType attrs) = do
23− tcMap <-ask
24− maybeRel <- lift $ runReaderT (arbitraryRelation attrs (0,5)) tcMap
25− case maybeRel of
26− Left err -> pure $ Left err
27− Right rel -> pure $ Right $ RelationAtom rel
28−
29−arbitrary' IntAtomType =
30− Right . IntAtom <$> lift (arbitrary :: Gen Int)
31−
32−arbitrary' DoubleAtomType =
33− Right . DoubleAtom <$> lift (arbitrary :: Gen Double)
34−
35−arbitrary' TextAtomType =
36− Right . TextAtom <$> lift (arbitrary :: Gen Text)
37−
38−arbitrary' DayAtomType =
39− Right . DayAtom <$> lift (arbitrary :: Gen Day)
40−
41−arbitrary' DateTimeAtomType =
42− Right . DateTimeAtom <$> lift (arbitrary :: Gen UTCTime)
43−
44−arbitrary' ByteStringAtomType =
45− Right . ByteStringAtom <$> lift (arbitrary :: Gen B.ByteString)
46−
47−arbitrary' BoolAtomType =
48− Right . BoolAtom <$> lift (arbitrary :: Gen Bool)
49−arbitrary' constructedAtomType@(ConstructedAtomType tcName tvMap)
50− --special-casing for Interval type
51− | isIntervalAtomType constructedAtomType = createArbitraryInterval (intervalSubType constructedAtomType)
52− | otherwise = do
53− tcMap <- ask
54− let maybeTCons = findTypeConstructor tcName tcMap
55− let eitherTCons = maybeToRight (NoSuchTypeConstructorName tcName) maybeTCons
56− let eitherDCDefs = snd <$> eitherTCons
57− let eitherGenDCDef = elements <$> eitherDCDefs
58− case eitherGenDCDef of
59− Left err -> pure $ Left err
60− Right genDCDef -> do
61− dcDef <- lift genDCDef
62− case resolvedAtomTypesForDataConstructorDefArgs tcMap tvMap dcDef of
63− Left err -> pure $ Left err
64− Right atomTypes -> do
65− let genListOfEitherAtom = mapM (\aTy->runReaderT (arbitrary' aTy) tcMap) atomTypes
66− listOfEitherAtom <- lift genListOfEitherAtom
67− let eitherListOfAtom = sequence listOfEitherAtom
68− case eitherListOfAtom of
69− Left err -> pure $ Left err
70− Right listOfAtom -> pure $ Right $ ConstructedAtom (DCD.name dcDef) constructedAtomType listOfAtom
71−arbitrary' (TypeVariableType _) = error "arbitrary on type variable"
7218
7319maybeToRight :: b -> Maybe a -> Either b a
7420maybeToRight _ (Just x) = Right x