ca72287 · project-m36 · git.iko.soy

git.iko.soy/project-m36

atom EQ redefinition branch complete

-all tests pass

commitca7228705bab31efea9ae6d571fad2b3b43d89bb authorAgentM <agentm@themactionfaction.com> dateWed 14 Oct 2015, 17:57 (11 years ago) parentb73dd7a

14 files changed+209−160

compare with master

unifiedsplit

ProjectM36/Atom.hs+45−5 ProjectM36/Base.hs+36−9 ProjectM36/Relation/Parse/CSV.hs+2−19 ProjectM36/RelationalExpression.hs+23−32 ProjectM36/TransactionGraph.hs+1−2 TutorialD/Interpreter/Base.hs+8−7 TutorialD/Interpreter/RelationalExpr.hs+17−13 benchmark/bigrel.hs+2−3 test/Relation/Basic.hs+5−5 test/Relation/Export/CSV.hs+7−6 test/Relation/Import/CSV.hs+7−6 test/TutorialD/Interpreter.hs+51−50 test/TutorialD/Interpreter/Import/TutorialD.hs+3−2 test/persistent-driver/test.hs+2−1

ProjectM36/Atom.hs+45−5

@@ -4,17 +4,16 @@ import ProjectM36.Base

44import ProjectM36.Error

55import Data.Typeable

66import ProjectM36.ConcreteTypeRep

7+import qualified Data.Text as T

8+import Data.Time.Calendar (Day)

9+import Data.Time.Clock

10+import Data.ByteString (ByteString)

711

812relationForAtom :: Atom -> Either RelationalError Relation

913relationForAtom (Atom atom) = case cast atom of

1014 Just rel@(Relation _ _) -> Right rel

1115 Nothing -> Left $ AttributeIsNotRelationValuedError ""

1216

13−atomTypeForAtom :: Atom -> AtomType

14−atomTypeForAtom (Atom atom) = case cast atom of

15− Just (Relation attrs _) -> RelationAtomType attrs

16− Nothing -> AtomType $ CTR (typeOf atom)

17−

1817atomTypeForProxy :: (Atomable a) => Proxy a -> AtomType

1918atomTypeForProxy prox = AtomType $ CTR (typeRep prox)

2019

@@ -27,3 +26,44 @@ intAtomType = atomTypeForProxy (Proxy :: Proxy Int)

2726

2827boolAtomType :: AtomType

2928boolAtomType = atomTypeForProxy (Proxy :: Proxy Bool)

29+

30+dateAtomType :: AtomType

31+dateAtomType = atomTypeForProxy (Proxy :: Proxy Day)

32+

33+dateTimeAtomType :: AtomType

34+dateTimeAtomType = atomTypeForProxy (Proxy :: Proxy UTCTime)

35+

36+byteStringAtomType :: AtomType

37+byteStringAtomType = atomTypeForProxy (Proxy :: Proxy ByteString)

38+

39+doubleAtomType :: AtomType

40+doubleAtomType = atomTypeForProxy (Proxy :: Proxy Double)

41+

42+--another hard-coded typerep dispatch table :/

43+makeAtomFromText :: AttributeName -> AtomType -> T.Text -> Either RelationalError Atom

44+makeAtomFromText _ (AtomType cTypeRep) textIn = if

45+ unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then

46+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String Int)

47+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Double) then

48+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String Double)

49+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy T.Text) then

50+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String T.Text)

51+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Day) then

52+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String Day)

53+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy UTCTime) then

54+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String UTCTime)

55+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy ByteString) then

56+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String ByteString)

57+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Bool) then

58+ either (Left . ParseError . T.pack) (Right . Atom) (fromText textIn :: Either String Bool)

59+ else

60+ Left $ ParseError textIn

61+makeAtomFromText attrName _ _ = Left $ AtomTypeNotSupported attrName

62+

63+--textAtom shortcut

64+stringAtom :: T.Text -> Atom

65+stringAtom t = Atom t

66+

67+--intAtom shortcut

68+intAtom :: Int -> Atom

69+intAtom i = Atom i

ProjectM36/Base.hs+36−9

@@ -43,7 +43,10 @@ class (Read a,

4343

4444instance Atomable Int

4545instance Atomable Double

46−instance Atomable Text

46+instance Atomable Text where

47+ --no need to require quoted strings

48+ fromText t = Right t

49+ toText t = t

4750instance Atomable Day

4851instance Atomable UTCTime

4952instance Atomable ByteString

@@ -60,18 +63,42 @@ instance Show Atom where

6063 show (Atom atom) = "Atom " ++ show atom

6164

6265instance Binary Atom where

63− put atom = put atom

66+ put atom@(Atom val) = put (atomTypeForAtom atom) >> put val

6467 get = do

65− r <- get :: (Get Atom)

66− return r

68+ atomtype <- get

69+ --not-so-great for this to be hardcoded here- it would be nicer to have a dispatch table linked to the instances themselves

70+ --http://stackoverflow.com/questions/8101067/binary-instance-for-an-existential

71+ case atomtype of

72+ AnyAtomType -> error "unsupported serialization AnyAtomType"

73+ (RelationAtomType _) -> Atom <$> (get :: Get Relation)

74+ (AtomType cTypeRep) -> if unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then

75+ Atom <$> (get :: Get Int)

76+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Text) then

77+ Atom <$> (get :: Get Text)

78+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Double) then

79+ Atom <$> (get :: Get Double)

80+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Day) then

81+ Atom <$> (get :: Get Day)

82+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy UTCTime) then

83+ Atom <$> (get :: Get UTCTime)

84+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy ByteString) then

85+ Atom <$> (get :: Get ByteString)

86+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Bool) then

87+ Atom <$> (get :: Get Bool)

88+ else

89+ error "unsupported typerep serialization"

6790

6891instance NFData Atom where

6992 rnf !(Atom a) = rnf a

7093

7194instance Hashable Atom where

7295 hashWithSalt salt (Atom a) = hashWithSalt salt a

73−

74−--not so great orphan instance

96+

97+atomTypeForAtom :: Atom -> AtomType

98+atomTypeForAtom (Atom atom) = case cast atom of

99+ Just (Relation attrs _) -> RelationAtomType attrs

100+ Nothing -> AtomType $ CTR (typeOf atom)

101+

75102instance Binary UTCTime where

76103 put utc = put $ toRational (utcTimeToPOSIXSeconds utc)

77104 get = do

@@ -82,13 +109,13 @@ instance Binary Day where

82109 put day = put $ toGregorian day

83110 get = do

84111 (y,m,d) <- get :: Get (Integer, Int, Int)

85− return $ fromGregorian y m d

112+ return (fromGregorian y m d)

86113

87114data AtomType = AtomType ConcreteTypeRep |

88115 RelationAtomType Attributes |

89116 AnyAtomType --wildcard used in Atom Functions

90− deriving (Eq,Show,NFData,Generic,Binary)

91−

117+ deriving (Eq,NFData,Generic,Binary,Show)

118+

92119isRelationAtomType :: AtomType -> Bool

93120isRelationAtomType (RelationAtomType _) = True

94121isRelationAtomType _ = False

ProjectM36/Relation/Parse/CSV.hs+2−19

@@ -7,7 +7,6 @@ import Data.Char (ord)

77import qualified Data.ByteString.Lazy as BS

88import ProjectM36.Base

99import ProjectM36.Relation

10−import ProjectM36.Atom

1110import ProjectM36.Error

1211import Data.Text.Encoding (decodeUtf8)

1312import qualified ProjectM36.Attribute as A

@@ -16,32 +15,16 @@ import Data.HashMap.Lazy as HM

1615import qualified Data.List as L

1716import qualified Data.Text as T

1817import Data.Attoparsec.ByteString.Lazy

19−import Text.Read (readMaybe)

20−import Data.Typeable (typeRep, Proxy(Proxy))

21−import ProjectM36.ConcreteTypeRep

22−import Data.Either (either)

18+import ProjectM36.Atom

2319

2420data CsvImportError = CsvParseError String |

2521 AttributeMappingError RelationalError |

26− UnsupportedAtomTypeError AttributeName |

2722 HeaderAttributeMismatchError (S.Set AttributeName)

2823 deriving (Show)

2924

3025csvDecodeOptions :: DecodeOptions

3126csvDecodeOptions = DecodeOptions {decDelimiter = fromIntegral (ord ',')}

3227

33−makeAtom :: AttributeName -> AtomType -> T.Text -> Either CsvImportError Atom

34−makeAtom attrName (AtomType cTypeRep) strIn = if unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then

35− either (Left . AttributeMappingError . ParseError . T.pack) (Right . Atom) ((fromText strIn) :: Either String Int)

36− else

37− Left $ AttributeMappingError (ParseError strIn)

38− {- where readAtomable :: (Atomable a) => Proxy a -> T.Text -> Either CsvImportError Atom

39− readAtomable _ strIn' = case fromText strIn of

40− Right val -> Right $ Atom (val :: a)

41− Left err -> Left $ AttributeMappingError (ParseError (T.pack err))-}

42−makeAtom attrName _ _ = Left $ UnsupportedAtomTypeError attrName

43−

44−

4528csvAsRelation :: BS.ByteString -> Attributes -> Either CsvImportError Relation

4629csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inString of

4730 Fail _ _ err -> Left (CsvParseError err)

@@ -53,7 +36,7 @@ csvAsRelation inString attrs = case parse (csvWithHeader csvDecodeOptions) inStr

5336 attrNameSet = S.fromList (V.toList attrNames)

5437 headerSet = S.fromList (V.toList strHeader)

5538 makeTupleList :: HM.HashMap AttributeName String -> [Either CsvImportError Atom]

56− makeTupleList tupMap = V.toList $ V.map (\attr -> makeAtom (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! (A.attributeName attr))) attrs

39+ makeTupleList tupMap = V.toList $ V.map (\attr -> either (Left . AttributeMappingError) Right $ makeAtomFromText (A.attributeName attr) (A.atomType attr) (T.pack $ tupMap HM.! (A.attributeName attr))) attrs

5740 case attrNameSet == headerSet of

5841 False -> Left $ HeaderAttributeMismatchError (S.difference attrNameSet headerSet)

5942 True -> do

ProjectM36/RelationalExpression.hs+23−32

@@ -16,7 +16,6 @@ import Control.Monad.State hiding (join)

1616import Data.Maybe

1717import Data.Either

1818import Data.Typeable (cast)

19−import qualified Data.Text as T

2019

2120--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

2221evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

@@ -144,14 +143,6 @@ dateExamples = DatabaseContext { inclusionDependencies = dateIncDeps,

144143 ]

145144 simplePKey attrNames relvarName = inclusionDependencyForKey (AttributeNames $ S.fromList attrNames) (RelationVariable relvarName)

146145

147−--textAtom shortcut

148−tAtom :: T.Text -> Atom

149−tAtom t = Atom t

150−

151−--intAtom shortcut

152−iAtom ::Int -> Atom

153−iAtom i = Atom i

154−

155146suppliersRel :: Relation

156147suppliersRel = case mkRelationFromList attrs atomMatrix of

157148 Left _ -> undefined

@@ -162,11 +153,11 @@ suppliersRel = case mkRelationFromList attrs atomMatrix of

162153 Attribute "STATUS" intAtomType,

163154 Attribute "CITY" stringAtomType]

164155 atomMatrix = [

165− [tAtom "S1", tAtom "Smith", iAtom 20, tAtom "London"],

166− [tAtom "S2", tAtom "Jones", iAtom 10, tAtom "Paris"],

167− [tAtom "S3", tAtom "Blake", iAtom 30, tAtom "Paris"],

168− [tAtom "S4", tAtom "Clark", iAtom 20, tAtom "London"],

169− [tAtom "S5", tAtom "Adams", iAtom 30, tAtom "Athens"]]

156+ [stringAtom "S1", stringAtom "Smith", intAtom 20, stringAtom "London"],

157+ [stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"],

158+ [stringAtom "S3", stringAtom "Blake", intAtom 30, stringAtom "Paris"],

159+ [stringAtom "S4", stringAtom "Clark", intAtom 20, stringAtom "London"],

160+ [stringAtom "S5", stringAtom "Adams", intAtom 30, stringAtom "Athens"]]

170161

171162supplierProductsRel :: Relation

172163supplierProductsRel = case mkRelationFromList attrs matrix of

@@ -177,18 +168,18 @@ supplierProductsRel = case mkRelationFromList attrs matrix of

177168 Attribute "P#" stringAtomType,

178169 Attribute "QTY" intAtomType]

179170 matrix = [

180− [tAtom "S1", tAtom "P1", iAtom 300],

181− [tAtom "S1", tAtom "P2", iAtom 200],

182− [tAtom "S1", tAtom "P3", iAtom 400],

183− [tAtom "S1", tAtom "P4", iAtom 200],

184− [tAtom "S1", tAtom "P5", iAtom 100],

185− [tAtom "S1", tAtom "P6", iAtom 100],

186− [tAtom "S2", tAtom "P1", iAtom 300],

187− [tAtom "S2", tAtom "P2", iAtom 400],

188− [tAtom "S3", tAtom "P2", iAtom 200],

189− [tAtom "S4", tAtom "P2", iAtom 200],

190− [tAtom "S4", tAtom "P4", iAtom 300],

191− [tAtom "S4", tAtom "P5", iAtom 400]

171+ [stringAtom "S1", stringAtom "P1", intAtom 300],

172+ [stringAtom "S1", stringAtom "P2", intAtom 200],

173+ [stringAtom "S1", stringAtom "P3", intAtom 400],

174+ [stringAtom "S1", stringAtom "P4", intAtom 200],

175+ [stringAtom "S1", stringAtom "P5", intAtom 100],

176+ [stringAtom "S1", stringAtom "P6", intAtom 100],

177+ [stringAtom "S2", stringAtom "P1", intAtom 300],

178+ [stringAtom "S2", stringAtom "P2", intAtom 400],

179+ [stringAtom "S3", stringAtom "P2", intAtom 200],

180+ [stringAtom "S4", stringAtom "P2", intAtom 200],

181+ [stringAtom "S4", stringAtom "P4", intAtom 300],

182+ [stringAtom "S4", stringAtom "P5", intAtom 400]

192183 ]

193184

194185productsRel :: Relation

@@ -202,12 +193,12 @@ productsRel = case mkRelationFromList attrs matrix of

202193 Attribute "WEIGHT" intAtomType,

203194 Attribute "CITY" stringAtomType]

204195 matrix = [

205− [tAtom "P1", tAtom "Nut", tAtom "Red", iAtom 12, tAtom "London"],

206− [tAtom "P2", tAtom "Bolt", tAtom "Green", iAtom 17, tAtom "Paris"],

207− [tAtom "P3", tAtom "Screw", tAtom "Blue", iAtom 17, tAtom "Oslo"],

208− [tAtom "P4", tAtom "Screw", tAtom "Red", iAtom 14, tAtom "London"],

209− [tAtom "P5", tAtom "Cam", tAtom "Blue", iAtom 12, tAtom "Paris"],

210− [tAtom "P6", tAtom "Cog", tAtom "Red", iAtom 19, tAtom "London"]

196+ [stringAtom "P1", stringAtom "Nut", stringAtom "Red", intAtom 12, stringAtom "London"],

197+ [stringAtom "P2", stringAtom "Bolt", stringAtom "Green", intAtom 17, stringAtom "Paris"],

198+ [stringAtom "P3", stringAtom "Screw", stringAtom "Blue", intAtom 17, stringAtom "Oslo"],

199+ [stringAtom "P4", stringAtom "Screw", stringAtom "Red", intAtom 14, stringAtom "London"],

200+ [stringAtom "P5", stringAtom "Cam", stringAtom "Blue", intAtom 12, stringAtom "Paris"],

201+ [stringAtom "P6", stringAtom "Cog", stringAtom "Red", intAtom 19, stringAtom "London"]

211202 ]

212203

213204--helper function to process relation variable creation/assignment

ProjectM36/TransactionGraph.hs+1−2

@@ -224,8 +224,7 @@ graphAsRelation (DisconnectedTransaction parentUUID _) graph@(TransactionGraph _

224224 parentAttributes = A.attributesFromList [Attribute "id" stringAtomType]

225225 tupleGenerator transaction = case transactionParentsRelation transaction graph of

226226 Left err -> Left err

227− Right parentTransRel -> Right [Atom $ T.pack $ show (transactionUUID transaction),

228−---- Atom parentTransRel,

227+ Right _ -> Right [Atom $ T.pack $ show (transactionUUID transaction),

229228 Atom $ parentUUID == transactionUUID transaction,

230229 Atom $ case headNameForTransaction transaction graph of

231230 Just headName -> headName

TutorialD/Interpreter/Base.hs+8−7

@@ -10,6 +10,7 @@ import qualified Data.List as L

1010import qualified Data.Vector as V

1111import qualified Data.Text.IO as TIO

1212import System.IO

13+import ProjectM36.Atom

1314

1415lexer :: Token.TokenParser ()

1516lexer = Token.makeTokenParser tutD

@@ -52,14 +53,14 @@ float = Token.float lexer

5253

5354atomTypeToTutDType :: AtomType -> Maybe T.Text

5455atomTypeToTutDType atomType = case atomType of

55− StringAtomType -> Just "char"

56− IntAtomType -> Just "int"

57− DateTimeAtomType -> Just "datetime"

58− DoubleAtomType -> Just "double"

59− DateAtomType -> Just "date"

60− RelationAtomType attrs -> Just $ "relation" `T.append` showRelationAttributes attrs

56+ aType@(AtomType _) -> lookup aType [(stringAtomType, "char"),

57+ (intAtomType, "int"),

58+ (boolAtomType, "bool"),

59+ (dateTimeAtomType, "datetime"),

60+ (doubleAtomType, "double")]

61+ (RelationAtomType attrs) -> Just $ "relation" `T.append` showRelationAttributes attrs

6162 _ -> Nothing

62−

63+

6364showRelationAttributes :: Attributes -> T.Text

6465showRelationAttributes attrs = "{" `T.append` T.concat (L.intersperse ", " $ map showAttribute attrsL) `T.append` "}"

6566 where

TutorialD/Interpreter/RelationalExpr.hs+17−13

@@ -15,14 +15,16 @@ import qualified Data.Set as S

1515import Data.Functor.Identity (Identity)

1616import Data.Time.Format

1717import Control.Applicative (liftA)

18+import Data.Time.Calendar (Day)

19+import Data.Time.Clock (UTCTime)

1820

1921atomTypeP :: Parser AtomType

20−atomTypeP = (reserved "char" *> return StringAtomType) <|>

21− (reserved "int" *> return IntAtomType) <|>

22− (reserved "datetime" *> return DateTimeAtomType) <|>

23− (reserved "date" *> return DateAtomType) <|>

24− (reserved "double" *> return DoubleAtomType) <|>

25− (reserved "bool" *> return BoolAtomType) <|>

22+atomTypeP = (reserved "char" *> return stringAtomType) <|>

23+ (reserved "int" *> return intAtomType) <|>

24+ (reserved "datetime" *> return dateTimeAtomType) <|>

25+ (reserved "date" *> return dateAtomType) <|>

26+ (reserved "double" *> return doubleAtomType) <|>

27+ (reserved "bool" *> return boolAtomType) <|>

2628 (RelationAtomType <$> (reserved "relation" *> makeAttributesP))

2729

2830--used in projection

@@ -236,7 +238,7 @@ relationalAtomExprP :: Parser AtomExpr

236238relationalAtomExprP = RelationAtomExpr <$> relExprP

237239

238240stringAtomP :: Parser Atom

239−stringAtomP = liftA (StringAtom . T.pack) quotedString

241+stringAtomP = liftA (Atom . T.pack) quotedString

240242

241243dateTimeAtomP :: Parser Atom

242244dateTimeAtomP = do

@@ -245,7 +247,7 @@ dateTimeAtomP = do

245247 reserved "::datetime"

246248 return dateTimeString

247249 case parseTimeM False defaultTimeLocale "%Y-%m-%d %H:%M:%S" dateTimeString' of

248− Just utctime -> return $ DateTimeAtom utctime

250+ Just utctime -> return $ Atom (utctime :: UTCTime)

249251 Nothing -> fail "Failed to parse datetime"

250252

251253dateAtomP :: Parser Atom

@@ -255,22 +257,24 @@ dateAtomP = do

255257 reserved "::date"

256258 return dateString

257259 case parseTimeM False defaultTimeLocale "%Y-%m-%d" dateString' of

258− Just utctime -> return $ DateAtom utctime

260+ Just todaytime -> return $ Atom (todaytime :: Day)

259261 Nothing -> fail "Failed to parse date"

260262

261263doubleAtomP :: Parser Atom

262−doubleAtomP = DoubleAtom <$> (try float)

264+doubleAtomP = Atom <$> (try float)

263265

264266intAtomP :: Parser Atom

265−intAtomP = (IntAtom . fromIntegral) <$> integer

267+intAtomP = do

268+ i <- integer

269+ return $ Atom ((fromIntegral i) :: Int)

266270

267271boolAtomP :: Parser Atom

268272boolAtomP = do

269273 val <- char 't' <|> char 'f'

270− return $ BoolAtom (val == 't')

274+ return $ Atom (val == 't')

271275

272276relationAtomP :: Parser Atom

273−relationAtomP = RelationAtom <$> relationP

277+relationAtomP = Atom <$> relationP

274278

275279--relation constructor -- no choice but to propagate relation-construction errors as parse errors. Perhaps this could be improved in the future

276280relationP :: Parser Relation

benchmark/bigrel.hs+2−3

@@ -1,7 +1,6 @@

11{-# LANGUAGE FlexibleInstances,OverloadedStrings #-}

22import ProjectM36.Base

33import ProjectM36.Relation

4−import ProjectM36.Tuple

54import ProjectM36.Relation.Show.CSV

65import ProjectM36.Relation.Show.HTML

76import TutorialD.Interpreter.Base (displayOpResult)

@@ -73,7 +72,7 @@ intmapMatrixRun = do

7372intmapMatrixRelation :: Int -> Int -> HS.HashSet (IM.IntMap Atom)

7473intmapMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]

7574 where

76− mapper tupCount = IM.fromList $ map (\c-> (c, IntAtom tupCount)) [0..attributeCount]

75+ mapper tupCount = IM.fromList $ map (\c-> (c, Atom tupCount)) [0..attributeCount]

7776

7877instance Hash.Hashable (IM.IntMap Atom) where

7978 hashWithSalt salt tupMap = Hash.hashWithSalt salt (show tupMap)

@@ -88,7 +87,7 @@ vectorMatrixRun = do

8887vectorMatrixRelation :: Int -> Int -> HS.HashSet (V.Vector Atom)

8988vectorMatrixRelation attributeCount tupleCount = HS.fromList $ map mapper [0..tupleCount]

9089 where

91− mapper tupCount = V.replicate attributeCount (IntAtom tupCount)

90+ mapper tupCount = V.replicate attributeCount (Atom tupCount)

9291

9392instance Hash.Hashable (V.Vector Atom) where

9493 hashWithSalt salt vec = Hash.hashWithSalt salt (show vec)

test/Relation/Basic.hs+5−5

@@ -62,8 +62,8 @@ simpleRel = case mkRelation attrs tupleSet of

6262 Right rel -> rel

6363 Left _ -> undefined

6464 where

65− attrs = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" StringAtomType]

66− tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [StringAtom "spam", StringAtom "spam2"])]

65+ attrs = A.attributesFromList [Attribute "a" stringAtomType, Attribute "b" stringAtomType]

66+ tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [stringAtom "spam", stringAtom "spam2"])]

6767

6868--rename tests

6969testRename1 :: Test

@@ -77,7 +77,7 @@ testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRe

7777testMkRelation1 :: Test

7878testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTypeMismatchError A.emptyAttributes) (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types

7979 where

80− testAttrs = A.attributesFromList [Attribute "a" StringAtomType]

81− testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [StringAtom "v"],

82− mkRelationTuple testAttrs $ V.fromList [IntAtom 2]]

80+ testAttrs = A.attributesFromList [Attribute "a" stringAtomType]

81+ testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [stringAtom "v"],

82+ mkRelationTuple testAttrs $ V.fromList [intAtom 2]]

8383

test/Relation/Export/CSV.hs+7−6

@@ -6,6 +6,7 @@ import ProjectM36.Relation.Show.CSV

66import ProjectM36.Relation.Parse.CSV

77import qualified ProjectM36.Attribute as A

88import ProjectM36.Relation

9+import ProjectM36.Atom

910

1011main :: IO ()

1112main = do

@@ -15,13 +16,13 @@ main = do

1516--round-trip a basic relation through CSV

1617testCSVExport :: Test

1718testCSVExport = TestCase $ do

18− let attrs = A.attributesFromList [Attribute "S#" StringAtomType,

19− Attribute "SNAME" StringAtomType,

20− Attribute "STATUS" IntAtomType,

21− Attribute "CITY" StringAtomType]

19+ let attrs = A.attributesFromList [Attribute "S#" stringAtomType,

20+ Attribute "SNAME" stringAtomType,

21+ Attribute "STATUS" intAtomType,

22+ Attribute "CITY" stringAtomType]

2223 relOrErr = mkRelationFromList attrs [

23− [StringAtom "S9", StringAtom "Perry", IntAtom 170, StringAtom "Londonderry"],

24− [StringAtom "S8", StringAtom "Mike", IntAtom 150, StringAtom "Boston"]]

24+ [stringAtom "S9", stringAtom "Perry", intAtom 170, stringAtom "Londonderry"],

25+ [stringAtom "S8", stringAtom "Mike", intAtom 150, stringAtom "Boston"]]

2526 case relOrErr of

2627 Left err -> assertFailure $ "export relation creation failure: " ++ (show err)

2728 Right rel -> do

test/Relation/Import/CSV.hs+7−6

@@ -7,6 +7,7 @@ import qualified ProjectM36.Attribute as A

77import System.Exit

88import qualified Data.Text.Lazy as T

99import Data.Text.Lazy.Encoding

10+import ProjectM36.Atom

1011

1112main :: IO ()

1213main = do

@@ -16,13 +17,13 @@ main = do

1617testCSVSuccess :: Test

1718testCSVSuccess = TestCase $ do

1819 let sampleCSV = (encodeUtf8 . T.pack) "S#,CITY,STATUS,SNAME\n\"S8\",\"Boston\",150,\"Mike\"\nS9,Londonderry,170,Perry"

19− expectedAttrs = A.attributesFromList [Attribute "S#" StringAtomType,

20− Attribute "SNAME" StringAtomType,

21− Attribute "STATUS" IntAtomType,

22− Attribute "CITY" StringAtomType]

20+ expectedAttrs = A.attributesFromList [Attribute "S#" stringAtomType,

21+ Attribute "SNAME" stringAtomType,

22+ Attribute "STATUS" intAtomType,

23+ Attribute "CITY" stringAtomType]

2324 expectedRel = mkRelationFromList expectedAttrs [

24− [StringAtom "S9", StringAtom "Perry", IntAtom 170, StringAtom "Londonderry"],

25− [StringAtom "S8", StringAtom "Mike", IntAtom 150, StringAtom "Boston"]]

25+ [stringAtom "S9", stringAtom "Perry", intAtom 170, stringAtom "Londonderry"],

26+ [stringAtom "S8", stringAtom "Mike", intAtom 150, stringAtom "Boston"]]

2627 case csvAsRelation sampleCSV expectedAttrs of

2728 Left err -> assertFailure $ show err

2829 Right csvRel -> assertEqual "csv->relation" expectedRel (Right csvRel)

test/TutorialD/Interpreter.hs+51−50

@@ -11,6 +11,7 @@ import ProjectM36.Error

1111import ProjectM36.Base

1212import ProjectM36.TransactionGraph

1313import ProjectM36.Client

14+import ProjectM36.Atom

1415import qualified ProjectM36.Attribute as A

1516import qualified Data.Map as M

1617import System.Exit

@@ -32,7 +33,7 @@ main = do

3233 ("x:=relation{a int}", mkRelation simpleAAttributes emptyTupleSet),

3334 ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),

3435 ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes emptyTupleSet),

35− ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ RelationTupleSet [(RelationTuple simpleCAttributes) (V.fromList [StringAtom "spam", IntAtom 5])]),

36+ ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ RelationTupleSet [(RelationTuple simpleCAttributes) (V.fromList [stringAtom "spam", intAtom 5])]),

3637 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),

3738 ("x:=y; x:=true", Left $ RelVarNotDefinedError "y"),

3839 ("x:=true where true", Right relationTrue),

@@ -44,46 +45,46 @@ main = do

4445 ("x:=true=true", Right relationTrue),

4546 ("x:=true=false", Right relationFalse),

4647 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),

47− ("x:=relation {b int, a char}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList [StringAtom "spam", IntAtom 5]]),

48+ ("x:=relation {b int, a char}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList[stringAtom "spam", intAtom 5]]),

4849 -- test nested relation constructor

49− ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ RelationTupleSet [RelationTuple nestedRelationAttributes (V.fromList [IntAtom 5, RelationAtom (Relation simpleAAttributes $ RelationTupleSet [RelationTuple simpleAAttributes $ V.fromList [IntAtom 6]])])]),

50− ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [StringAtom "spam", IntAtom 5])]),

51− ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ RelationTupleSet [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 5])]),

52− ("x:=relation{tuple{a 5}} : {b:=6}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 6])]),

53− ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 10])]),

54− ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 IntAtomType StringAtomType)),

55− ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [IntAtom 5, IntAtom 12])])

50+ ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ RelationTupleSet [RelationTuple nestedRelationAttributes (V.fromList [intAtom 5, Atom (Relation simpleAAttributes $ RelationTupleSet [RelationTuple simpleAAttributes $ V.fromList [intAtom 6]])])]),

51+ ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [stringAtom "spam", intAtom 5])]),

52+ ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ RelationTupleSet [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 5])]),

53+ ("x:=relation{tuple{a 5}} : {b:=6}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 6])]),

54+ ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 10])]),

55+ ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 intAtomType stringAtomType)),

56+ ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 12])])

5657 ]

57− simpleAAttributes = A.attributesFromList [Attribute "a" IntAtomType]

58− simpleBAttributes = A.attributesFromList [Attribute "d" IntAtomType]

59− simpleCAttributes = A.attributesFromList [Attribute "a" StringAtomType, Attribute "b" IntAtomType]

60− simpleDAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" IntAtomType]

61− simpleProjectionAttributes = A.attributesFromList [Attribute "c" IntAtomType]

62− nestedRelationAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" (RelationAtomType $ A.attributesFromList [Attribute "a" IntAtomType])]

63− extendTestAttributes = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" $ RelationAtomType (attributes suppliersRel)]

64− groupCountAttrs = A.attributesFromList [Attribute "z" IntAtomType]

65− minMaxAttrs = A.attributesFromList [Attribute "S#" StringAtomType, Attribute "z" IntAtomType]

58+ simpleAAttributes = A.attributesFromList [Attribute "a" intAtomType]

59+ simpleBAttributes = A.attributesFromList [Attribute "d" intAtomType]

60+ simpleCAttributes = A.attributesFromList [Attribute "a" stringAtomType, Attribute "b" intAtomType]

61+ simpleDAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" intAtomType]

62+ simpleProjectionAttributes = A.attributesFromList [Attribute "c" intAtomType]

63+ nestedRelationAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" (RelationAtomType $ A.attributesFromList [Attribute "a" intAtomType])]

64+ extendTestAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" $ RelationAtomType (attributes suppliersRel)]

65+ groupCountAttrs = A.attributesFromList [Attribute "z" intAtomType]

66+ minMaxAttrs = A.attributesFromList [Attribute "S#" stringAtomType, Attribute "z" intAtomType]

6667 dateExampleRelTests = [("x:=S where true", Right suppliersRel),

67− ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ StringAtom "London")) suppliersRel),

68+ ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ stringAtom "London")) suppliersRel),

6869 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),

69− ("x:=P where COLOR=\"Blue\" and CITY=\"Paris\"", mkRelationFromList (attributes productsRel) [[StringAtom "P5", StringAtom "Cam", StringAtom "Blue", IntAtom 12, StringAtom "Paris"]]),

70− ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [ Attribute "STATUS" IntAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "STATUS" IntAtomType]) (V.fromList [IntAtom 50])])),

70+ ("x:=P where COLOR=\"Blue\" and CITY=\"Paris\"", mkRelationFromList (attributes productsRel) [[stringAtom "P5", stringAtom "Cam", stringAtom "Blue", intAtom 12, stringAtom "Paris"]]),

71+ ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [Attribute "STATUS" intAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "STATUS" intAtomType]) (V.fromList [intAtom 50])])),

7172 --atom function tests

7273 ("x:=((S : {STATUS2 := add(10,@STATUS)}) where STATUS2=add(10,@STATUS)){CITY,S#,SNAME,STATUS}", Right suppliersRel),

73− ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ StringAtom "Blake") then updateTuple (M.singleton "CITY" (StringAtom "Boston")) tuple else tuple) suppliersRel),

74− ("x:=relation{tuple{a 5}} : {b:=S}", mkRelation extendTestAttributes (RelationTupleSet [mkRelationTuple extendTestAttributes (V.fromList [IntAtom 5, RelationAtom suppliersRel])])),

74+ ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ stringAtom "Blake") then updateTuple (M.singleton "CITY" (stringAtom "Boston")) tuple else tuple) suppliersRel),

75+ ("x:=relation{tuple{a 5}} : {b:=S}", mkRelation extendTestAttributes (RelationTupleSet [mkRelationTuple extendTestAttributes (V.fromList [intAtom 5, Atom suppliersRel])])),

7576 --relatom function tests

76− ("x:=((S group ({CITY} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ IntAtom 1)])),

77+ ("x:=((S group ({CITY} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ intAtom 1)])),

7778 ("x:=(SP group ({S#} as y)) ungroup y", Right supplierProductsRel),

78− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

79− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

80− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [StringAtom s,IntAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

79+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

80+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

81+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

8182 --boolean function restriction

82− ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

83− ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[StringAtom "S3", StringAtom "Blake", IntAtom 30, StringAtom "Paris"],

84− [StringAtom "S5", StringAtom "Adams", IntAtom 30, StringAtom "Athens"]]),

85− ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError IntAtomType BoolAtomType),

86− ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[StringAtom "S2", StringAtom "Jones", IntAtom 10, StringAtom "Paris"]]),

83+ ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"]]),

84+ ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[stringAtom "S3", stringAtom "Blake", intAtom 30, stringAtom "Paris"],

85+ [stringAtom "S5", stringAtom "Adams", intAtom 30, stringAtom "Athens"]]),

86+ ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError intAtomType boolAtomType),

87+ ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"]]),

8788 --test "all but" attribute inversion syntax

8889 ("x:=S{all but S#} = S{CITY,SNAME,STATUS}", Right $ relationTrue),

8990 --test key syntax

@@ -179,24 +180,24 @@ transactionBranchTest = TestCase $ do

179180simpleJoinTest :: Test

180181simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP"

181182 where

182− attrs = A.attributesFromList [Attribute "CITY" StringAtomType,

183− Attribute "QTY" IntAtomType,

184− Attribute "P#" StringAtomType,

185− Attribute "S#" StringAtomType,

186− Attribute "SNAME" StringAtomType,

187− Attribute "STATUS" IntAtomType]

188− joinedRel = mkRelationFromList attrs [[StringAtom "London", IntAtom 100, StringAtom "P6", StringAtom "S1", StringAtom "Smith", IntAtom 20],

189− [StringAtom "London", IntAtom 400, StringAtom "P3", StringAtom "S1", StringAtom "Smith", IntAtom 20],

190− [StringAtom "London", IntAtom 400, StringAtom "P5", StringAtom "S4", StringAtom "Clark", IntAtom 20],

191− [StringAtom "London", IntAtom 300, StringAtom "P1", StringAtom "S1", StringAtom "Smith", IntAtom 20],

192− [StringAtom "Paris", IntAtom 200, StringAtom "P2", StringAtom "S3", StringAtom "Blake", IntAtom 30],

193− [StringAtom "Paris", IntAtom 300, StringAtom "P1", StringAtom "S2", StringAtom "Jones", IntAtom 10],

194− [StringAtom "London", IntAtom 100, StringAtom "P5", StringAtom "S1", StringAtom "Smith", IntAtom 20],

195− [StringAtom "London", IntAtom 300, StringAtom "P4", StringAtom "S4", StringAtom "Clark", IntAtom 20],

196− [StringAtom "Paris", IntAtom 400, StringAtom "P2", StringAtom "S2", StringAtom "Jones", IntAtom 10],

197− [StringAtom "London", IntAtom 200, StringAtom "P2", StringAtom "S1", StringAtom "Smith", IntAtom 20],

198− [StringAtom "London", IntAtom 200, StringAtom "P4", StringAtom "S1", StringAtom "Smith", IntAtom 20],

199− [StringAtom "London", IntAtom 200, StringAtom "P2", StringAtom "S4", StringAtom "Clark", IntAtom 20]

183+ attrs = A.attributesFromList [Attribute "CITY" stringAtomType,

184+ Attribute "QTY" intAtomType,

185+ Attribute "P#" stringAtomType,

186+ Attribute "S#" stringAtomType,

187+ Attribute "SNAME" stringAtomType,

188+ Attribute "STATUS" intAtomType]

189+ joinedRel = mkRelationFromList attrs [[stringAtom "London", intAtom 100, stringAtom "P6", stringAtom "S1", stringAtom "Smith", intAtom 20],

190+ [stringAtom "London", intAtom 400, stringAtom "P3", stringAtom "S1", stringAtom "Smith", intAtom 20],

191+ [stringAtom "London", intAtom 400, stringAtom "P5", stringAtom "S4", stringAtom "Clark", intAtom 20],

192+ [stringAtom "London", intAtom 300, stringAtom "P1", stringAtom "S1", stringAtom "Smith", intAtom 20],

193+ [stringAtom "Paris", intAtom 200, stringAtom "P2", stringAtom "S3", stringAtom "Blake", intAtom 30],

194+ [stringAtom "Paris", intAtom 300, stringAtom "P1", stringAtom "S2", stringAtom "Jones", intAtom 10],

195+ [stringAtom "London", intAtom 100, stringAtom "P5", stringAtom "S1", stringAtom "Smith", intAtom 20],

196+ [stringAtom "London", intAtom 300, stringAtom "P4", stringAtom "S4", stringAtom "Clark", intAtom 20],

197+ [stringAtom "Paris", intAtom 400, stringAtom "P2", stringAtom "S2", stringAtom "Jones", intAtom 10],

198+ [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S1", stringAtom "Smith", intAtom 20],

199+ [stringAtom "London", intAtom 200, stringAtom "P4", stringAtom "S1", stringAtom "Smith", intAtom 20],

200+ [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S4", stringAtom "Clark", intAtom 20]

200201 ]

201202

202203dateExamplesConnection :: IO (Connection)

test/TutorialD/Interpreter/Import/TutorialD.hs+3−2

@@ -1,6 +1,7 @@

11{-# LANGUAGE OverloadedStrings #-}

22import Test.HUnit

33import ProjectM36.Base

4+import ProjectM36.Atom

45import qualified ProjectM36.Attribute as A

56import TutorialD.Interpreter.Import.TutorialD

67import System.Exit

@@ -20,7 +21,7 @@ testTutdImport = TestCase $ do

2021 withSystemTempFile "m.tutd" $ \tempPath handle -> do

2122 hPutStrLn handle "x:=relation{tuple{a 5,b \"spam\"}}"

2223 hClose handle

23− let expectedExpr = MultipleExpr [Assign "x" (ExistingRelation (Relation expectedAttrs $ RelationTupleSet [RelationTuple expectedAttrs $ V.fromList [IntAtom 5, StringAtom "spam"]]))]

24− expectedAttrs = A.attributesFromList [Attribute "a" IntAtomType, Attribute "b" StringAtomType]

24+ let expectedExpr = MultipleExpr [Assign "x" (ExistingRelation (Relation expectedAttrs $ RelationTupleSet [RelationTuple expectedAttrs $ V.fromList [intAtom 5, stringAtom "spam"]]))]

25+ expectedAttrs = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" stringAtomType]

2526 imported <- importTutorialD tempPath DC.empty

2627 assertEqual "import tutd" (Right expectedExpr) imported

test/persistent-driver/test.hs+2−1

@@ -10,6 +10,7 @@

1010import Test.HUnit

1111import Database.Persist.ProjectM36

1212import ProjectM36.Client

13+import ProjectM36.Atom

1314import qualified ProjectM36.Client as C

1415import System.Exit

1516import Database.Persist

@@ -41,7 +42,7 @@ inProcSettings = InProcessConnectionInfo NoPersistence

4142

4243defPersonRel :: Connection -> IO ()

4344defPersonRel conn = do

44− maybeErr <- C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" StringAtomType, Attribute "age" IntAtomType, Attribute "id" StringAtomType]))

45+ maybeErr <- C.executeDatabaseContextExpr conn (Define "person" (attributesFromList [Attribute "name" stringAtomType, Attribute "age" intAtomType, Attribute "id" stringAtomType]))

4546 case maybeErr of

4647 Nothing -> return ()

4748 Just err -> assertFailure $ "defPersonRel" ++ show err