c121f16 · project-m36 · git.iko.soy

ProjectM36/Atom.hs+8

compare with master

unifiedsplit

@@ -17,6 +17,8 @@ atomTypeForAtom (IntAtom _) = IntAtomType

17atomTypeForAtom (RelationAtom (Relation attributes _)) = RelationAtomType attributes

18atomTypeForAtom (BoolAtom _) = BoolAtomType

19atomTypeForAtom (DateTimeAtom _) = DateTimeAtomType

20+atomTypeForAtom (DateAtom _) = DateAtomType

21+atomTypeForAtom (DoubleAtom _) = DoubleAtomType

20

22

21{- a generic string constructor for atoms

23{- a generic string constructor for atoms

22used by CSV relation generation

24used by CSV relation generation

@@ -36,4 +38,10 @@ atomFromString DateTimeAtomType strIn =

36 case parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" strIn of

38 case parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" strIn of

37 Just utctime -> Right $ DateTimeAtom utctime

39 Just utctime -> Right $ DateTimeAtom utctime

38 Nothing -> Left $ ParseError "Failed to parse datetime"

40 Nothing -> Left $ ParseError "Failed to parse datetime"

41+atomFromString DoubleAtomType strIn = case readMaybe strIn of

42+ Just d -> Right $ DoubleAtom d

43+ Nothing -> Left (ParseError "Failed to parse double")

44+atomFromString DateAtomType strIn = case parseTime defaultTimeLocale "%Y-%m-%d" strIn of

45+ Just date -> Right $ DateTimeAtom date

46+ Nothing -> Left $ ParseError "Failed to parse datetime"

39atomFromString AnyAtomType _ = Left $ ParseError "Parsing AnyAtomType is not supported"

47atomFromString AnyAtomType _ = Left $ ParseError "Parsing AnyAtomType is not supported"

ProjectM36/Base.hs+13−1

@@ -17,7 +17,9 @@ import Data.Vector.Binary()

17import ProjectM36.HashSetBinary ()

18import Data.Time.Clock

19import Data.Time.Clock.POSIX

20+import Data.Time.Calendar (Day,toGregorian,fromGregorian)

20import Data.Hashable.Time ()

21import Data.Hashable.Time ()

22+import Control.Monad (liftM)

21

23

22type StringType = T.Text

24type StringType = T.Text

23

25

@@ -25,7 +27,9 @@ data Atom = StringAtom StringType |

25 IntAtom Int |

27 IntAtom Int |

26 BoolAtom Bool |

28 BoolAtom Bool |

27 RelationAtom Relation |

29 RelationAtom Relation |

28− DateTimeAtom UTCTime

30+ DateTimeAtom UTCTime |

31+ DateAtom Day |

32+ DoubleAtom Double

29 deriving (Show, Eq, Generic)

33 deriving (Show, Eq, Generic)

30

34

31--not so great orphan instance

35--not so great orphan instance

@@ -34,6 +38,12 @@ instance Binary UTCTime where

34 get = do

38 get = do

35 r <- get :: Get Rational

39 r <- get :: Get Rational

36 return (posixSecondsToUTCTime (fromRational r))

40 return (posixSecondsToUTCTime (fromRational r))

41+

42+instance Binary Day where

43+ put day = put $ toGregorian day

44+ get = do

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

46+ return $ fromGregorian y m d

37

47

38instance NFData Atom where rnf = genericRnf

48instance NFData Atom where rnf = genericRnf

39

49

@@ -46,6 +56,8 @@ data AtomType = StringAtomType |

46 BoolAtomType |

56 BoolAtomType |

47 RelationAtomType Attributes |

57 RelationAtomType Attributes |

48 DateTimeAtomType |

58 DateTimeAtomType |

59+ DateAtomType |

60+ DoubleAtomType |

49 AnyAtomType --AnyAtomType is used as a wildcard

61 AnyAtomType --AnyAtomType is used as a wildcard

50 deriving (Eq, Show, Generic)

62 deriving (Eq, Show, Generic)

51

63

ProjectM36/Relation/Show/CSV.hs+1−1

@@ -11,7 +11,7 @@ relationAsCSV :: Relation -> BS.ByteString

11relationAsCSV (Relation _ tupleSet) = tupleSetAsCSV tupleSet

12

13tupleSetAsCSV :: RelationTupleSet -> BS.ByteString

14−tupleSetAsCSV tupleSet = encode $ V.fromList (HS.toList tupleSet)

14+tupleSetAsCSV tupleSet = encode (HS.toList tupleSet)

15

16instance ToRecord RelationTuple where

17 toRecord tuple = toRecord $ map toField (V.toList $ tupleAtoms tuple)

ProjectM36/Relation/Show/Term.hs+2

@@ -97,6 +97,8 @@ showAtom (IntAtom atom) = T.pack $ show atom

97showAtom (RelationAtom rel) = renderTable $ relationAsTable rel

98showAtom (BoolAtom bool) = T.pack $ show bool

99showAtom (DateTimeAtom dt) = T.pack $ show dt

100+showAtom (DateAtom d) = T.pack $ show d

101+showAtom (DoubleAtom d) = T.pack $ show d

100

102

101renderTable :: Table -> StringType

103renderTable :: Table -> StringType

102renderTable table = renderHeader table (fst cellLocs) `T.append` renderBody (snd table) cellLocs

104renderTable table = renderHeader table (fst cellLocs) `T.append` renderBody (snd table) cellLocs

TutorialD/Interpreter/Base.hs+6−1

@@ -45,14 +45,19 @@ semi = Token.semi lexer

45whiteSpace :: Parser ()

46whiteSpace = Token.whiteSpace lexer

47

48−integer :: Parser (Integer)

48+integer :: Parser Integer

49integer = Token.integer lexer

50

51+float :: Parser Double

52+float = Token.float lexer

53+

51atomTypeToTutDType :: AtomType -> Maybe T.Text

54atomTypeToTutDType :: AtomType -> Maybe T.Text

52atomTypeToTutDType atomType = case atomType of

55atomTypeToTutDType atomType = case atomType of

53 StringAtomType -> Just "char"

56 StringAtomType -> Just "char"

54 IntAtomType -> Just "int"

57 IntAtomType -> Just "int"

55 DateTimeAtomType -> Just "datetime"

58 DateTimeAtomType -> Just "datetime"

59+ DoubleAtomType -> Just "double"

60+ DateAtomType -> Just "date"

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

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

57 _ -> Nothing

62 _ -> Nothing

58

63

TutorialD/Interpreter/Import/Base.hs−2

@@ -1,8 +1,6 @@

1module TutorialD.Interpreter.Import.Base where

2import ProjectM36.Base

3import ProjectM36.Error

4−import ProjectM36.Relation

5−import qualified Data.Map as M

6

4

7data DataImportOperator = DataImportOperator FilePath (FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr))

5data DataImportOperator = DataImportOperator FilePath (FilePath -> DatabaseContext -> IO (Either RelationalError DatabaseExpr))

8

6

TutorialD/Interpreter/RelationalExpr.hs+20−7

@@ -223,7 +223,7 @@ nakedAtomExprP :: Parser AtomExpr

223nakedAtomExprP = NakedAtomExpr <$> atomP

224

225atomP :: Parser Atom

226−atomP = dateTimeAtomP <|> stringAtomP <|> intAtomP <|> boolAtomP <|> relationAtomP

227

228functionAtomExprP :: Parser AtomExpr

229functionAtomExprP = do

@@ -239,15 +239,28 @@ stringAtomP = liftA (StringAtom . T.pack) quotedString

239

240dateTimeAtomP :: Parser Atom

241dateTimeAtomP = do

242− dateString' <- try $ do

242+ dateTimeString' <- try $ do

243− dateString <- quotedString

243+ dateTimeString <- quotedString

244− reserved "::dt"

244+ reserved "::datetime"

245− return dateString

245+ return dateTimeString

246 --deprecated in time 1.5- needs update for GHC 7.10

247− case parseTime defaultTimeLocale "%Y-%m-%d %H:%M" dateString' of

247+ case parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" dateTimeString' of

248 Just utctime -> return $ DateTimeAtom utctime

249 Nothing -> fail "Failed to parse datetime"

250−

250+

251+dateAtomP :: Parser Atom

252+dateAtomP = do

253+ dateString' <- try $ do

254+ dateString <- quotedString

255+ reserved "::date"

256+ return dateString

257+ case parseTime defaultTimeLocale "%Y-%m-%d" dateString' of

258+ Just utctime -> return $ DateAtom utctime

259+ Nothing -> fail "Failed to parse date"

260+

261+doubleAtomP :: Parser Atom

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

263+

251intAtomP :: Parser Atom

264intAtomP :: Parser Atom

252intAtomP = (IntAtom . fromIntegral) <$> integer

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

253

266