1608744 · project-m36 · git.iko.soy

ProjectM36/Atom.hs+2−1

compare with master

unifiedsplit

@@ -11,4 +11,5 @@ atomTypeForAtom :: Atom -> AtomType

11atomTypeForAtom (StringAtom _) = StringAtomType

12atomTypeForAtom (IntAtom _) = IntAtomType

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

14−atomTypeForAtom (BoolAtom _) = BoolAtomType

14+atomTypeForAtom (BoolAtom _) = BoolAtomType

15+atomTypeForAtom (DateTimeAtom _) = DateTimeAtomType

ProjectM36/Base.hs+15−3

@@ -4,7 +4,7 @@ import qualified Data.Map as M

4import qualified Data.HashSet as HS

5import qualified Data.Hashable as Hash

6import qualified Data.Set as S

7−import Control.Monad.State hiding (join)

7+import Control.Monad.State (State)

8import Data.UUID (UUID)

9import Control.DeepSeq (NFData, rnf)

10import Control.DeepSeq.Generics (genericRnf)

@@ -14,15 +14,26 @@ import qualified Data.List as L

14import qualified Data.Text as T

15import Data.Binary

16import Data.Vector.Binary()

17−import ProjectM36.HashSetBinary()

17+import ProjectM36.HashSetBinary ()

18+import Data.Time.Clock

19+import Data.Time.Clock.POSIX

20+import Data.Hashable.Time ()

18

21

19type StringType = T.Text

22type StringType = T.Text

20

23

21data Atom = StringAtom StringType |

24data Atom = StringAtom StringType |

22 IntAtom Int |

25 IntAtom Int |

23 BoolAtom Bool |

26 BoolAtom Bool |

24− RelationAtom Relation

27+ RelationAtom Relation |

28+ DateTimeAtom UTCTime

25 deriving (Show, Eq, Generic)

29 deriving (Show, Eq, Generic)

30+

31+--not so great orphan instance

32+instance Binary UTCTime where

33+ put utc = put $ toRational (utcTimeToPOSIXSeconds utc)

34+ get = do

35+ r <- get :: Get Rational

36+ return (posixSecondsToUTCTime (fromRational r))

26

37

27instance NFData Atom where rnf = genericRnf

38instance NFData Atom where rnf = genericRnf

28

39

@@ -34,6 +45,7 @@ data AtomType = StringAtomType |

34 IntAtomType |

45 IntAtomType |

35 BoolAtomType |

46 BoolAtomType |

36 RelationAtomType Attributes |

47 RelationAtomType Attributes |

48+ DateTimeAtomType |

37 AnyAtomType --AnyAtomType is used as a wildcard

49 AnyAtomType --AnyAtomType is used as a wildcard

38 deriving (Eq, Show, Generic)

50 deriving (Eq, Show, Generic)

39

51

ProjectM36/Relation/Show/HTML.hs+1

@@ -32,6 +32,7 @@ atomAsHTML (StringAtom atom) = atom

32atomAsHTML (IntAtom int) = pack (show int)

33atomAsHTML (RelationAtom rel) = relationAsHTML rel

34atomAsHTML (BoolAtom bool) = pack (show bool)

35+atomAsHTML (DateTimeAtom dt) = pack (show dt)

35

36

36tupleAsHTML :: RelationTuple -> Text

37tupleAsHTML :: RelationTuple -> Text

37tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

38tupleAsHTML tuple = "<tr>" `append` T.concat (L.map tupleFrag (tupleSortedAssocs tuple)) `append` "</tr>"

ProjectM36/Relation/Show/Term.hs+1

@@ -96,6 +96,7 @@ showAtom (StringAtom atom) = atom

96showAtom (IntAtom atom) = T.pack $ show atom

97showAtom (RelationAtom rel) = renderTable $ relationAsTable rel

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

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

99

100

100renderTable :: Table -> StringType

101renderTable :: Table -> StringType

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

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

TutorialD/Interpreter/Base.hs+1

@@ -51,6 +51,7 @@ atomTypeToTutDType :: AtomType -> Maybe T.Text

51atomTypeToTutDType atomType = case atomType of

52 StringAtomType -> Just "char"

53 IntAtomType -> Just "int"

54+ DateTimeAtomType -> Just "datetime"

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

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

55 _ -> Nothing

56 _ -> Nothing

56

57

TutorialD/Interpreter/RelationalExpr.hs+19−3

@@ -15,11 +15,13 @@ import qualified Data.Vector as V

15import qualified Data.Set as S

16import Control.Applicative (liftA, (<*), (*>), (<$>))

17import Data.Functor.Identity (Identity)

18−

18+import Data.Time.Format

19+import System.Locale

19

20

20atomTypeP :: Parser AtomType

21atomTypeP :: Parser AtomType

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

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

22 (reserved "int" *> return IntAtomType) <|>

23 (reserved "int" *> return IntAtomType) <|>

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

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

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

24

26

25--used in projection

27--used in projection

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

221nakedAtomExprP = NakedAtomExpr <$> atomP

223nakedAtomExprP = NakedAtomExpr <$> atomP

222

224

223atomP :: Parser Atom

225atomP :: Parser Atom

224−atomP = stringAtomP <|> intAtomP <|> boolAtomP <|> relationAtomP

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

225

227

226functionAtomExprP :: Parser AtomExpr

228functionAtomExprP :: Parser AtomExpr

227functionAtomExprP = do

229functionAtomExprP = do

@@ -237,7 +239,21 @@ quotedChar = noneOf "\""

237 <|> try (string "\"\"" >> return '"')

239 <|> try (string "\"\"" >> return '"')

238

240

239stringAtomP :: Parser Atom

241stringAtomP :: Parser Atom

240−stringAtomP = liftA (StringAtom . T.pack) (string "\"" *> many quotedChar <* string "\"")

242+stringAtomP = liftA (StringAtom . T.pack) quotedString

243+

244+quotedString :: Parser String

245+quotedString = string "\"" *> many quotedChar <* string "\""

246+

247+dateTimeAtomP :: Parser Atom

248+dateTimeAtomP = do

249+ dateString' <- try $ do

250+ dateString <- quotedString

251+ reserved "::dt"

252+ return dateString

253+ --deprecated in time 1.5- needs update for GHC 7.10

254+ case parseTime defaultTimeLocale "%Y-%m-%d %H:%M" dateString' of

255+ Just utctime -> return $ DateTimeAtom utctime

256+ Nothing -> fail "Failed to parse datetime"

241

257

242intAtomP :: Parser Atom

258intAtomP :: Parser Atom

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

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

project-m36.cabal+1−1

@@ -7,7 +7,7 @@ Category: Relational Algebra

7Cabal-Version: >= 1.2

8

9Library

10− Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers,gnuplot,binary,filepath,directory,vector-binary-instances,unix,temporary,stm

10+ Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava,text,bytestring,deepseq,deepseq-generics,vector,parallel,monad-parallel,transformers,gnuplot,binary,filepath,directory,vector-binary-instances,unix,temporary,stm,time,hashable-time,old-locale

11 Exposed-Modules: ProjectM36.Error,

12 ProjectM36.Transaction,

13 ProjectM36.TransactionGraph,