{-# LANGUAGE ExistentialQuantification,FlexibleInstances,OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module ProjectM36.Arbitrary where
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.AtomFunctionError
import ProjectM36.AtomType
import ProjectM36.Attribute (atomType)
import ProjectM36.DataConstructorDef as DCD
import ProjectM36.DataTypes.Interval
import ProjectM36.Relation
import qualified Data.Vector as V
import Data.Text (Text)
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import qualified Data.ByteString.Char8 as B
import Data.Time
import Control.Monad.Reader
import Data.UUID
import Data.Scientific

arbitrary' :: AtomType -> WithTCMap Gen (Either RelationalError Atom)
arbitrary' :: AtomType -> WithTCMap Gen (Either RelationalError Atom)
arbitrary' AtomType
IntegerAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Integer -> Atom) -> Integer -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Atom
IntegerAtom (Integer -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Integer
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer -> ReaderT TypeConstructorMapping Gen Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Integer
forall a. Arbitrary a => Gen a
arbitrary :: Gen Integer)

arbitrary' AtomType
ScientificAtomType =
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Scientific -> Atom)
-> Scientific
-> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Atom
ScientificAtom (Scientific -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Scientific
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific -> ReaderT TypeConstructorMapping Gen Scientific
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Scientific
forall a. Arbitrary a => Gen a
arbitrary :: Gen Scientific)

arbitrary' (RelationAtomType Attributes
attrs)  = do
  TypeConstructorMapping
tcMap <-ReaderT TypeConstructorMapping Gen TypeConstructorMapping
forall r (m :: * -> *). MonadReader r m => m r
ask
  Either RelationalError Relation
maybeRel <- Gen (Either RelationalError Relation)
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen (Either RelationalError Relation)
 -> ReaderT
      TypeConstructorMapping Gen (Either RelationalError Relation))
-> Gen (Either RelationalError Relation)
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ ReaderT
  TypeConstructorMapping Gen (Either RelationalError Relation)
-> TypeConstructorMapping -> Gen (Either RelationalError Relation)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Attributes
-> Range
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
arbitraryRelation Attributes
attrs (Int
0,Int
5)) TypeConstructorMapping
tcMap
  case Either RelationalError Relation
maybeRel of
    Left RelationalError
err -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err
    Right Relation
rel -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> Atom -> Either RelationalError Atom
forall a b. (a -> b) -> a -> b
$ Relation -> Atom
RelationAtom Relation
rel

arbitrary' AtomType
IntAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Int -> Atom) -> Int -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Atom
IntAtom (Int -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Int
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int -> ReaderT TypeConstructorMapping Gen Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Int
forall a. Arbitrary a => Gen a
arbitrary :: Gen Int)

arbitrary' AtomType
DoubleAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Double -> Atom) -> Double -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Atom
DoubleAtom (Double -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Double
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double -> ReaderT TypeConstructorMapping Gen Double
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Double
forall a. Arbitrary a => Gen a
arbitrary :: Gen Double)

arbitrary' AtomType
TextAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Text -> Atom) -> Text -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Atom
TextAtom (Text -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Text
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text -> ReaderT TypeConstructorMapping Gen Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Text
forall a. Arbitrary a => Gen a
arbitrary :: Gen Text)

arbitrary' AtomType
DayAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Day -> Atom) -> Day -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Atom
DayAtom (Day -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Day
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Gen Day -> ReaderT TypeConstructorMapping Gen Day
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Day
forall a. Arbitrary a => Gen a
arbitrary :: Gen Day)

arbitrary' AtomType
DateTimeAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (UTCTime -> Atom) -> UTCTime -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Atom
DateTimeAtom (UTCTime -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen UTCTime
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTCTime -> ReaderT TypeConstructorMapping Gen UTCTime
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary :: Gen UTCTime)
  
arbitrary' AtomType
ByteStringAtomType =
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (ByteString -> Atom)
-> ByteString
-> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Atom
ByteStringAtom (ByteString -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen ByteString
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString -> ReaderT TypeConstructorMapping Gen ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary :: Gen B.ByteString)

arbitrary' AtomType
BoolAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (Bool -> Atom) -> Bool -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Atom
BoolAtom (Bool -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen Bool
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool -> ReaderT TypeConstructorMapping Gen Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Bool
forall a. Arbitrary a => Gen a
arbitrary :: Gen Bool)

arbitrary' AtomType
UUIDAtomType = 
  Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> (UUID -> Atom) -> UUID -> Either RelationalError Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Atom
UUIDAtom (UUID -> Either RelationalError Atom)
-> ReaderT TypeConstructorMapping Gen UUID
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UUID -> ReaderT TypeConstructorMapping Gen UUID
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen UUID
forall a. Arbitrary a => Gen a
arbitrary :: Gen UUID)

arbitrary' AtomType
RelationalExprAtomType =
  Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (RelationalExpr -> Atom
RelationalExprAtom (Relation -> RelationalExpr
forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue))) -- don't bother with arbitrary relational expressions

arbitrary' constructedAtomType :: AtomType
constructedAtomType@(ConstructedAtomType Text
tcName TypeVarMap
tvMap)
  --special-casing for Interval type
  | AtomType -> Bool
isIntervalAtomType AtomType
constructedAtomType = AtomType -> WithTCMap Gen (Either RelationalError Atom)
createArbitraryInterval (AtomType -> AtomType
intervalSubType AtomType
constructedAtomType)
  | Bool
otherwise = do 
  TypeConstructorMapping
tcMap <- ReaderT TypeConstructorMapping Gen TypeConstructorMapping
forall r (m :: * -> *). MonadReader r m => m r
ask
  let maybeTCons :: Maybe (TypeConstructorDef, [DataConstructorDef])
maybeTCons = Text
-> TypeConstructorMapping
-> Maybe (TypeConstructorDef, [DataConstructorDef])
findTypeConstructor Text
tcName TypeConstructorMapping
tcMap
  let eitherTCons :: Either RelationalError (TypeConstructorDef, [DataConstructorDef])
eitherTCons = RelationalError
-> Maybe (TypeConstructorDef, [DataConstructorDef])
-> Either
     RelationalError (TypeConstructorDef, [DataConstructorDef])
forall b a. b -> Maybe a -> Either b a
maybeToRight (Text -> RelationalError
NoSuchTypeConstructorName Text
tcName) Maybe (TypeConstructorDef, [DataConstructorDef])
maybeTCons
  let eitherDCDefs :: Either RelationalError [DataConstructorDef]
eitherDCDefs = (TypeConstructorDef, [DataConstructorDef]) -> [DataConstructorDef]
forall a b. (a, b) -> b
snd ((TypeConstructorDef, [DataConstructorDef])
 -> [DataConstructorDef])
-> Either
     RelationalError (TypeConstructorDef, [DataConstructorDef])
-> Either RelationalError [DataConstructorDef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RelationalError (TypeConstructorDef, [DataConstructorDef])
eitherTCons
  let eitherGenDCDef :: Either RelationalError (Gen DataConstructorDef)
eitherGenDCDef = [DataConstructorDef] -> Gen DataConstructorDef
forall a. [a] -> Gen a
elements ([DataConstructorDef] -> Gen DataConstructorDef)
-> Either RelationalError [DataConstructorDef]
-> Either RelationalError (Gen DataConstructorDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either RelationalError [DataConstructorDef]
eitherDCDefs
  case Either RelationalError (Gen DataConstructorDef)
eitherGenDCDef of
    Left RelationalError
err -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err
    Right Gen DataConstructorDef
genDCDef -> do
      DataConstructorDef
dcDef <- Gen DataConstructorDef
-> ReaderT TypeConstructorMapping Gen DataConstructorDef
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen DataConstructorDef
genDCDef
      case TypeConstructorMapping
-> TypeVarMap
-> DataConstructorDef
-> Either RelationalError [AtomType]
resolvedAtomTypesForDataConstructorDefArgs TypeConstructorMapping
tcMap TypeVarMap
tvMap DataConstructorDef
dcDef of
        Left RelationalError
err -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err
        Right [AtomType]
atomTypes -> do
          let genListOfEitherAtom :: Gen [Either RelationalError Atom]
genListOfEitherAtom = (AtomType -> Gen (Either RelationalError Atom))
-> [AtomType] -> Gen [Either RelationalError Atom]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\AtomType
aTy->WithTCMap Gen (Either RelationalError Atom)
-> TypeConstructorMapping -> Gen (Either RelationalError Atom)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AtomType -> WithTCMap Gen (Either RelationalError Atom)
arbitrary' AtomType
aTy) TypeConstructorMapping
tcMap) [AtomType]
atomTypes
          [Either RelationalError Atom]
listOfEitherAtom <- Gen [Either RelationalError Atom]
-> ReaderT TypeConstructorMapping Gen [Either RelationalError Atom]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Gen [Either RelationalError Atom]
genListOfEitherAtom
          let eitherListOfAtom :: Either RelationalError [Atom]
eitherListOfAtom = [Either RelationalError Atom] -> Either RelationalError [Atom]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either RelationalError Atom]
listOfEitherAtom
          case Either RelationalError [Atom]
eitherListOfAtom of 
            Left RelationalError
err -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err
            Right [Atom]
listOfAtom -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right (Atom -> Either RelationalError Atom)
-> Atom -> Either RelationalError Atom
forall a b. (a -> b) -> a -> b
$ Text -> AtomType -> [Atom] -> Atom
ConstructedAtom (DataConstructorDef -> Text
DCD.name DataConstructorDef
dcDef) AtomType
constructedAtomType [Atom]
listOfAtom
arbitrary' (TypeVariableType Text
_) = [Char] -> WithTCMap Gen (Either RelationalError Atom)
forall a. HasCallStack => [Char] -> a
error [Char]
"arbitrary on type variable"

maybeToRight :: b -> Maybe a -> Either b a
maybeToRight :: b -> Maybe a -> Either b a
maybeToRight b
_ (Just a
x) = a -> Either b a
forall a b. b -> Either a b
Right a
x
maybeToRight b
y Maybe a
Nothing  = b -> Either b a
forall a b. a -> Either a b
Left b
y

arbitraryRelationTuple :: Attributes -> WithTCMap Gen (Either RelationalError RelationTuple)
arbitraryRelationTuple :: Attributes -> WithTCMap Gen (Either RelationalError RelationTuple)
arbitraryRelationTuple Attributes
attris = do
  TypeConstructorMapping
tcMap <- ReaderT TypeConstructorMapping Gen TypeConstructorMapping
forall r (m :: * -> *). MonadReader r m => m r
ask
  [Either RelationalError Atom]
listOfMaybeAType <- Gen [Either RelationalError Atom]
-> ReaderT TypeConstructorMapping Gen [Either RelationalError Atom]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen [Either RelationalError Atom]
 -> ReaderT
      TypeConstructorMapping Gen [Either RelationalError Atom])
-> Gen [Either RelationalError Atom]
-> ReaderT TypeConstructorMapping Gen [Either RelationalError Atom]
forall a b. (a -> b) -> a -> b
$ (Attribute -> Gen (Either RelationalError Atom))
-> [Attribute] -> Gen [Either RelationalError Atom]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((\AtomType
aTy -> WithTCMap Gen (Either RelationalError Atom)
-> TypeConstructorMapping -> Gen (Either RelationalError Atom)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (AtomType -> WithTCMap Gen (Either RelationalError Atom)
arbitrary' AtomType
aTy) TypeConstructorMapping
tcMap) (AtomType -> Gen (Either RelationalError Atom))
-> (Attribute -> AtomType)
-> Attribute
-> Gen (Either RelationalError Atom)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> AtomType
atomType) (Vector Attribute -> [Attribute]
forall a. Vector a -> [a]
V.toList (Attributes -> Vector Attribute
attributesVec Attributes
attris))
  case [Either RelationalError Atom] -> Either RelationalError [Atom]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either RelationalError Atom]
listOfMaybeAType of
    Left RelationalError
err -> Either RelationalError RelationTuple
-> WithTCMap Gen (Either RelationalError RelationTuple)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError RelationTuple
 -> WithTCMap Gen (Either RelationalError RelationTuple))
-> Either RelationalError RelationTuple
-> WithTCMap Gen (Either RelationalError RelationTuple)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError RelationTuple
forall a b. a -> Either a b
Left RelationalError
err
    Right [Atom]
listOfAttr -> do
      let vectorOfAttr :: Vector Atom
vectorOfAttr = [Atom] -> Vector Atom
forall a. [a] -> Vector a
V.fromList [Atom]
listOfAttr
      Either RelationalError RelationTuple
-> WithTCMap Gen (Either RelationalError RelationTuple)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError RelationTuple
 -> WithTCMap Gen (Either RelationalError RelationTuple))
-> Either RelationalError RelationTuple
-> WithTCMap Gen (Either RelationalError RelationTuple)
forall a b. (a -> b) -> a -> b
$ RelationTuple -> Either RelationalError RelationTuple
forall a b. b -> Either a b
Right (RelationTuple -> Either RelationalError RelationTuple)
-> RelationTuple -> Either RelationalError RelationTuple
forall a b. (a -> b) -> a -> b
$ Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
attris Vector Atom
vectorOfAttr

arbitraryWithRange :: Gen (Either RelationalError RelationTuple) -> Range -> Gen [Either RelationalError RelationTuple]
arbitraryWithRange :: Gen (Either RelationalError RelationTuple)
-> Range -> Gen [Either RelationalError RelationTuple]
arbitraryWithRange Gen (Either RelationalError RelationTuple)
genEitherTuple Range
range = do
  Int
num <- Range -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose Range
range
  Int
-> Gen (Either RelationalError RelationTuple)
-> Gen [Either RelationalError RelationTuple]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
num Gen (Either RelationalError RelationTuple)
genEitherTuple

arbitraryRelation :: Attributes -> Range -> WithTCMap Gen (Either RelationalError Relation)
arbitraryRelation :: Attributes
-> Range
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
arbitraryRelation Attributes
attris Range
range = do
  TypeConstructorMapping
tcMap <- ReaderT TypeConstructorMapping Gen TypeConstructorMapping
forall r (m :: * -> *). MonadReader r m => m r
ask
  let genEitherTuple :: Gen (Either RelationalError RelationTuple)
genEitherTuple = WithTCMap Gen (Either RelationalError RelationTuple)
-> TypeConstructorMapping
-> Gen (Either RelationalError RelationTuple)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Attributes -> WithTCMap Gen (Either RelationalError RelationTuple)
arbitraryRelationTuple Attributes
attris) TypeConstructorMapping
tcMap
  [Either RelationalError RelationTuple]
listOfEitherTuple <- Gen [Either RelationalError RelationTuple]
-> ReaderT
     TypeConstructorMapping Gen [Either RelationalError RelationTuple]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen [Either RelationalError RelationTuple]
 -> ReaderT
      TypeConstructorMapping Gen [Either RelationalError RelationTuple])
-> Gen [Either RelationalError RelationTuple]
-> ReaderT
     TypeConstructorMapping Gen [Either RelationalError RelationTuple]
forall a b. (a -> b) -> a -> b
$ Gen (Either RelationalError RelationTuple)
-> Range -> Gen [Either RelationalError RelationTuple]
arbitraryWithRange Gen (Either RelationalError RelationTuple)
genEitherTuple Range
range
  let eitherTupleList :: Either RelationalError [RelationTuple]
eitherTupleList = [Either RelationalError RelationTuple]
-> Either RelationalError [RelationTuple]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either RelationalError RelationTuple]
listOfEitherTuple
  case Either RelationalError [RelationTuple]
eitherTupleList of
    Left RelationalError
err -> Either RelationalError Relation
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
 -> ReaderT
      TypeConstructorMapping Gen (Either RelationalError Relation))
-> Either RelationalError Relation
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left RelationalError
err
    Right [RelationTuple]
tupleList ->  Either RelationalError Relation
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
 -> ReaderT
      TypeConstructorMapping Gen (Either RelationalError Relation))
-> Either RelationalError Relation
-> ReaderT
     TypeConstructorMapping Gen (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ Relation -> Either RelationalError Relation
forall a b. b -> Either a b
Right (Relation -> Either RelationalError Relation)
-> Relation -> Either RelationalError Relation
forall a b. (a -> b) -> a -> b
$ Attributes -> RelationTupleSet -> Relation
Relation Attributes
attris (RelationTupleSet -> Relation) -> RelationTupleSet -> Relation
forall a b. (a -> b) -> a -> b
$ [RelationTuple] -> RelationTupleSet
RelationTupleSet [RelationTuple]
tupleList

type WithTCMap a = ReaderT TypeConstructorMapping a 

createArbitraryInterval :: AtomType -> WithTCMap Gen (Either RelationalError Atom)
createArbitraryInterval :: AtomType -> WithTCMap Gen (Either RelationalError Atom)
createArbitraryInterval AtomType
subType = if AtomType -> Bool
supportsInterval AtomType
subType then do
  Either RelationalError Atom
eBegin <- AtomType -> WithTCMap Gen (Either RelationalError Atom)
arbitrary' AtomType
subType
  Either RelationalError Atom
eEnd <- AtomType -> WithTCMap Gen (Either RelationalError Atom)
arbitrary' AtomType
subType
  Bool
beginopen <- Gen Bool -> ReaderT TypeConstructorMapping Gen Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Bool
forall a. Arbitrary a => Gen a
arbitrary :: Gen Bool)
  Bool
endopen <- Gen Bool -> ReaderT TypeConstructorMapping Gen Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Gen Bool
forall a. Arbitrary a => Gen a
arbitrary :: Gen Bool)
  case Either RelationalError Atom
eBegin of
    Left RelationalError
err -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err)
    Right Atom
begin -> 
      case Either RelationalError Atom
eEnd of
        Left RelationalError
err -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left RelationalError
err)
        Right Atom
end -> 
          case Atom -> Atom -> Bool -> Bool -> Either AtomFunctionError Atom
createInterval Atom
begin Atom
end Bool
beginopen Bool
endopen of
            Left AtomFunctionError
_ -> AtomType -> WithTCMap Gen (Either RelationalError Atom)
createArbitraryInterval AtomType
subType
            Right Atom
val -> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right Atom
val)
  else
    Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Atom
 -> WithTCMap Gen (Either RelationalError Atom))
-> Either RelationalError Atom
-> WithTCMap Gen (Either RelationalError Atom)
forall a b. (a -> b) -> a -> b
$ RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left (AtomFunctionError -> RelationalError
ProjectM36.Error.AtomFunctionUserError (Text -> AtomFunctionError
AtomTypeDoesNotSupportIntervalError (AtomType -> Text
prettyAtomType AtomType
subType)))