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