on master help sign in
Just backup some files. About to receive upstream master.
commitfd940a7df726fffec15ef2fd71cf7726b11cddf9 authorJohnny Liao <dycan0716@gmail.com> dateSat 26 May 2018, 10:14 (8 years ago) parent8285a58
2 files changed+33−99
src/lib/ProjectM36/Base.hs+33−16 src/lib/ProjectM36/MyTest.hs−83
src/lib/ProjectM36/Base.hs+33−16
@@ -1,4 +1,4 @@
1−{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass, TypeSynonymInstances, FlexibleInstances,OverloadedStrings #-}
1+{-# LANGUAGE ExistentialQuantification,DeriveGeneric,DeriveAnyClass,TypeSynonymInstances,FlexibleInstances,OverloadedStrings #-}
22{-# OPTIONS_GHC -fno-warn-orphans #-}
33
44module ProjectM36.Base where
@@ -33,7 +33,6 @@ import qualified Data.ByteString.Char8 as B
3333import Data.Time
3434import Data.Time.Clock
3535
36−
3736type StringType = Text
3837
3938-- | Database atoms are the smallest, undecomposable units of a tuple. Common examples are integers, text, or unique identity keys.
@@ -540,7 +539,31 @@ instance Eq DatabaseContextFunction where
540539 f1 == f2 = dbcFuncName f1 == dbcFuncName f2
541540
542541
543−-- for creating arbitrary tuples
542+-- for creating arbitrary relations
543+
544+arbitrary' :: AtomType -> Gen Atom
545+arbitrary' IntegerAtomType = IntegerAtom <$> (arbitrary :: Gen Integer)
546+arbitrary' IntAtomType = IntAtom <$> (arbitrary :: Gen Int)
547+arbitrary' DoubleAtomType = DoubleAtom <$> (arbitrary :: Gen Double)
548+arbitrary' TextAtomType = TextAtom <$> (arbitrary :: Gen Text)
549+arbitrary' DayAtomType = DayAtom <$> (arbitrary :: Gen Day)
550+<<<<<<< Updated upstream
551+arbitrary' DateTimeAtomType = DateTimeAtom <$> (arbitrary :: Gen UTCTime)
552+arbitrary' BoolAtomType = BoolAtom <$> (arbitrary :: Gen Bool)
553+arbitrary' (IntervalAtomType atomTy) = IntervalAtom <$> (arbitrary' atomTy) <*> (arbitrary' atomTy) <*> arbitrary <*> arbitrary
554+arbitrary' (RelationAtomType attrs) = arbitraryRel attrs (0,10)
555+arbitrary' (ConstructedAtomType tcname tvmap) = undefined -- ConstructedAtom DataConstructorName AtomType [Atom]
556+arbitrary' (ConstructedAtomType tcname tvmap) = do
557+
558+=======
559+arbitrary' DateTimeAtomType = undefined
560+arbitrary' BoolAtomType = BoolAtom <$> (arbitrary :: Gen Bool)
561+arbitrary' (IntervalAtomType atomTy) = undefined
562+arbitrary' (RelationAtomType attrs) = RelationAtom <$> (arbitrary :: Gen Relation) -- Right now, it only gives predefined attributes without Relation attribute.
563+arbitrary' (ConstructedAtomType tcname tvmap) = undefined -- ConstructedAtom DataConstructorName AtomType [Atom]
564+>>>>>>> Stashed changes
565+arbitrary' (TypeVariableType tvname) = undefined
566+
544567instance Arbitrary Text where
545568 arbitrary = pack <$> elements ["Mary", "Johnny", "Sunny", "Ted"]
546569
@@ -560,7 +583,7 @@ instance {-# OVERLAPPING #-} Arbitrary TypeVarMap where
560583 arbitrary = undefined
561584
562585instance Arbitrary UTCTime where
563− arbitrary = UTCTime <$> arbitrary <*> (secondsToDiffTime <$> arbitrary)
586+ arbitrary = UTCTime <$> arbitrary <*> (secondsToDiffTime <$> choose(0,86400))
564587
565588instance Arbitrary B.ByteString where
566589 arbitrary = B.pack <$> (arbitrary :: Gen String)
@@ -569,6 +592,7 @@ defAttributeNames = ["Number","People","Time","Thing"]
569592defAtomtypes = [IntAtomType, TextAtomType, DayAtomType, TextAtomType]
570593defAttributes = V.fromList $ zipWith Attribute defAttributeNames defAtomtypes
571594
595+{-
572596instance Arbitrary RelationTuple where
573597 arbitrary = do
574598 a <- IntAtom <$> (arbitrary :: Gen Int)
@@ -582,12 +606,13 @@ instance Arbitrary Relation where
582606 arbitrary = do
583607 list <- listOf (arbitrary :: Gen RelationTuple)
584608 return $ Relation defAttributes (RelationTupleSet list)
609+-}
585610
586611arbitraryRelationTuple attris = do
587− let attrisG = V.fromList <$> mapM (arbitrary'.getAtomType) (V.toList attris)
612+ let attrisG = V.fromList <$> mapM (arbitrary' . atomType') (V.toList attris)
588613 RelationTuple attris <$> attrisG
589614
590−arbitraryRel attris bound@(min,max) = do
615+arbitraryRel attris range@(min,max) = do
591616 num <- choose (min,max)
592617 let tupleListG = vectorOf num (arbitraryRelationTuple attris)
593618 Relation attris <$> (RelationTupleSet <$> tupleListG)
@@ -600,13 +625,5 @@ instance Arbitrary Atom where
600625
601626instance ToADTArbitrary Atom
602627
603−arbitrary' :: AtomType -> Gen Atom
604−arbitrary' IntAtomType = IntAtom <$> (arbitrary :: Gen Int)
605−arbitrary' IntegerAtomType = IntegerAtom <$> (arbitrary :: Gen Integer)
606−arbitrary' TextAtomType = TextAtom <$> (arbitrary :: Gen Text)
607−arbitrary' DayAtomType = DayAtom <$> (arbitrary :: Gen Day)
608−arbitrary' BoolAtomType = BoolAtom <$> (arbitrary :: Gen Bool)
609−arbitrary' _ = undefined
610−
611−getAtomType :: Attribute -> AtomType
612−getAtomType (Attribute _ atomType) = atomType
628+atomType' :: Attribute -> AtomType
629+atomType' (Attribute _ atype) = atype
src/lib/ProjectM36/MyTest.hsdeleted−83
@@ -1,83 +0,0 @@
1−{-# Language TypeSynonymInstances,FlexibleInstances,OverloadedStrings #-}
2−module ProjectM36.MyTest where
3−import ProjectM36.Base
4−import Test.QuickCheck
5−import Test.QuickCheck.Gen
6−import Test.QuickCheck.Random
7−import Test.QuickCheck.Arbitrary.ADT
8−import qualified Data.Text as T
9−import qualified Data.ByteString.Char8 as B
10−import Data.Time
11−import Data.Time.Clock
12−import qualified Data.Vector as V
13−import qualified Data.Map as M
14−
15−{-
16−instance Arbitrary Atom where
17− arbitrary = IntAtom <$> int
18− where int = (arbitrary :: Gen Int)
19−
20−genAtom :: IO Atom
21−genAtom = do
22− seed <- newQCGen
23− return $ unGen (arbitrary :: Gen Atom) seed (2^29-1)
24−-}
25−
26−instance Arbitrary T.Text where
27− arbitrary = T.pack <$> elements ["Mary", "Johnny", "Sunny", "Ted"] --(arbitrary :: Gen String)
28−
29−instance Arbitrary Day where
30− arbitrary = ModifiedJulianDay <$> (arbitrary :: Gen Integer)
31−
32−instance Arbitrary Attribute where
33− arbitrary = genericArbitrary
34−
35−instance (Arbitrary a) => Arbitrary (V.Vector a) where
36− arbitrary = do
37− maxbound <- choose (0,5)
38− V.fromList <$> vectorOf maxbound arbitrary
39−
40−instance {-# OVERLAPPING #-} Arbitrary TypeVarMap where
41− arbitrary = undefined
42−
43−instance Arbitrary UTCTime where
44− arbitrary = UTCTime <$> arbitrary <*> (secondsToDiffTime <$> arbitrary)
45−
46−instance Arbitrary B.ByteString where
47− arbitrary = B.pack <$> (arbitrary :: Gen String)
48−
49−-- arbitrary attributes seems to involve dependant-type techniques and seems unneccsary for a dud example.
50−attributeNames = ["Number","People","Time","Thing"]
51−atomtypes = [IntAtomType, TextAtomType, DayAtomType, TextAtomType]
52−attributes = V.fromList $ zipWith Attribute attributeNames atomtypes
53−
54−instance Arbitrary RelationTuple where
55− arbitrary = do
56− a <- IntAtom <$> (arbitrary :: Gen Int)
57− b <- TextAtom <$> (arbitrary :: Gen T.Text)
58− c <- DayAtom <$> (arbitrary :: Gen Day)
59− d <- TextAtom <$> (arbitrary :: Gen T.Text)
60− let sample = V.fromList [a,b,c,d]
61− return $ RelationTuple attributes sample
62−
63−instance Arbitrary Relation where
64− arbitrary = do
65− list <- listOf (arbitrary :: Gen RelationTuple)
66− return $ Relation attributes (RelationTupleSet list)
67−
68−
69−instance Arbitrary AtomType where
70− arbitrary = genericArbitrary
71−
72−instance Arbitrary Atom where
73− arbitrary = genericArbitrary
74−
75−instance ToADTArbitrary Atom
76−
77−
78−--three parts
79−-- s# generation
80−-- expr -> Relation
81−-- keyword arbitrary
82−-- database context: seed + expr
83−--