git.iko.soy/project-m36
on master help sign in
add DateTime data type
commit1608744183f88c0a830371fdea1e9e30572b909c authorAgentM <agentm@themactionfaction.com> dateTue 21 Jul 2015, 13:42 (11 years ago) parentac258da
7 files changed+40−8
compare with master
unifiedsplit
ProjectM36/Atom.hs+2−1 ProjectM36/Base.hs+15−3 ProjectM36/Relation/Show/HTML.hs+1 ProjectM36/Relation/Show/Term.hs+1 TutorialD/Interpreter/Base.hs+1 TutorialD/Interpreter/RelationalExpr.hs+19−3 project-m36.cabal+1−1
ProjectM36/Atom.hs+2−1
@@ -11,4 +11,5 @@ atomTypeForAtom :: Atom -> AtomType
1111atomTypeForAtom (StringAtom _) = StringAtomType
1212atomTypeForAtom (IntAtom _) = IntAtomType
1313atomTypeForAtom (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
44import qualified Data.HashSet as HS
55import qualified Data.Hashable as Hash
66import qualified Data.Set as S
7−import Control.Monad.State hiding (join)
7+import Control.Monad.State (State)
88import Data.UUID (UUID)
99import Control.DeepSeq (NFData, rnf)
1010import Control.DeepSeq.Generics (genericRnf)
@@ -14,15 +14,26 @@ import qualified Data.List as L
1414import qualified Data.Text as T
1515import Data.Binary
1616import 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 ()
1821
1922type StringType = T.Text
2023
2124data Atom = StringAtom StringType |
2225 IntAtom Int |
2326 BoolAtom Bool |
24− RelationAtom Relation
27+ RelationAtom Relation |
28+ DateTimeAtom UTCTime
2529 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))
2637
2738instance NFData Atom where rnf = genericRnf
2839
@@ -34,6 +45,7 @@ data AtomType = StringAtomType |
3445 IntAtomType |
3546 BoolAtomType |
3647 RelationAtomType Attributes |
48+ DateTimeAtomType |
3749 AnyAtomType --AnyAtomType is used as a wildcard
3850 deriving (Eq, Show, Generic)
3951
ProjectM36/Relation/Show/HTML.hs+1
@@ -32,6 +32,7 @@ atomAsHTML (StringAtom atom) = atom
3232atomAsHTML (IntAtom int) = pack (show int)
3333atomAsHTML (RelationAtom rel) = relationAsHTML rel
3434atomAsHTML (BoolAtom bool) = pack (show bool)
35+atomAsHTML (DateTimeAtom dt) = pack (show dt)
3536
3637tupleAsHTML :: RelationTuple -> Text
3738tupleAsHTML 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
9696showAtom (IntAtom atom) = T.pack $ show atom
9797showAtom (RelationAtom rel) = renderTable $ relationAsTable rel
9898showAtom (BoolAtom bool) = T.pack $ show bool
99+showAtom (DateTimeAtom dt) = T.pack $ show dt
99100
100101renderTable :: Table -> StringType
101102renderTable 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
5151atomTypeToTutDType atomType = case atomType of
5252 StringAtomType -> Just "char"
5353 IntAtomType -> Just "int"
54+ DateTimeAtomType -> Just "datetime"
5455 RelationAtomType attrs -> Just $ "relation" `T.append` showRelationAttributes attrs
5556 _ -> Nothing
5657
TutorialD/Interpreter/RelationalExpr.hs+19−3
@@ -15,11 +15,13 @@ import qualified Data.Vector as V
1515import qualified Data.Set as S
1616import Control.Applicative (liftA, (<*), (*>), (<$>))
1717import Data.Functor.Identity (Identity)
18−
18+import Data.Time.Format
19+import System.Locale
1920
2021atomTypeP :: Parser AtomType
2122atomTypeP = (reserved "char" *> return StringAtomType) <|>
2223 (reserved "int" *> return IntAtomType) <|>
24+ (reserved "datetime" *> return DateTimeAtomType) <|>
2325 (RelationAtomType <$> (reserved "relation" *> makeAttributesP))
2426
2527--used in projection
@@ -221,7 +223,7 @@ nakedAtomExprP :: Parser AtomExpr
221223nakedAtomExprP = NakedAtomExpr <$> atomP
222224
223225atomP :: Parser Atom
224−atomP = stringAtomP <|> intAtomP <|> boolAtomP <|> relationAtomP
226+atomP = dateTimeAtomP <|> stringAtomP <|> intAtomP <|> boolAtomP <|> relationAtomP
225227
226228functionAtomExprP :: Parser AtomExpr
227229functionAtomExprP = do
@@ -237,7 +239,21 @@ quotedChar = noneOf "\""
237239 <|> try (string "\"\"" >> return '"')
238240
239241stringAtomP :: 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"
241257
242258intAtomP :: Parser Atom
243259intAtomP = (IntAtom . fromIntegral) <$> integer
project-m36.cabal+1−1
@@ -7,7 +7,7 @@ Category: Relational Algebra
77Cabal-Version: >= 1.2
88
99Library
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
1111 Exposed-Modules: ProjectM36.Error,
1212 ProjectM36.Transaction,
1313 ProjectM36.TransactionGraph,