c438855 · project-m36 · git.iko.soy

git.iko.soy/project-m36

add bytestring atom type

-fix some orphan instance warnings

commitc4388558da316029b6ddac9f40dfd428f8d7a52b authorAgentM <agentm@themactionfaction.com> dateWed 7 Oct 2015, 13:47 (11 years ago) parent2f2b8a9

9 files changed+56−21

compare with master

unifiedsplit

ProjectM36/Atom.hs+7−1 ProjectM36/Base.hs+4−2 ProjectM36/Relation/Show/CSV.hs+19−14 ProjectM36/Relation/Show/HTML.hs+2−1 ProjectM36/Relation/Show/Term.hs+2 TutorialD/Interpreter/RelationalExpr.hs+15−1 docs/tutd_tutorial.markdown+1 project-m36.cabal+1−1 test/TutorialD/Interpreter.hs+5−1

ProjectM36/Atom.hs+7−1

@@ -5,6 +5,8 @@ import ProjectM36.Error

55import qualified Data.Text as T

66import Text.Read (readMaybe)

77import Data.Time.Format

8+import Data.ByteString.Base64

9+import qualified Data.Text.Encoding as TE

810

911relationForAtom :: Atom -> Either RelationalError Relation

1012relationForAtom (RelationAtom rel) = Right rel

@@ -18,6 +20,7 @@ atomTypeForAtom (BoolAtom _) = BoolAtomType

1820atomTypeForAtom (DateTimeAtom _) = DateTimeAtomType

1921atomTypeForAtom (DateAtom _) = DateAtomType

2022atomTypeForAtom (DoubleAtom _) = DoubleAtomType

23+atomTypeForAtom (ByteStringAtom _) = ByteStringAtomType

2124

2225{- a generic string constructor for atoms

2326used by CSV relation generation

@@ -42,4 +45,7 @@ atomFromString DoubleAtomType strIn = case readMaybe strIn of

4245atomFromString DateAtomType strIn = case parseTimeM False defaultTimeLocale "%Y-%m-%d" strIn of

4346 Just date -> Right $ DateAtom date

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

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

48+atomFromString ByteStringAtomType strIn = case decode (TE.encodeUtf8 (T.pack strIn)) of

49+ Left err -> Left $ ParseError (T.pack err)

50+ Right bsVal -> Right $ ByteStringAtom bsVal

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

ProjectM36/Base.hs+4−2

@@ -19,6 +19,7 @@ import Data.Time.Clock

1919import Data.Time.Clock.POSIX

2020import Data.Time.Calendar (Day,toGregorian,fromGregorian)

2121import Data.Hashable.Time ()

22+import qualified Data.ByteString as BS

2223

2324type StringType = T.Text

2425

@@ -28,10 +29,10 @@ data Atom = StringAtom StringType |

2829 RelationAtom Relation |

2930 DateTimeAtom UTCTime |

3031 DateAtom Day |

31− DoubleAtom Double

32+ DoubleAtom Double |

33+ ByteStringAtom BS.ByteString

3234 deriving (Show, Eq, Generic)

3335

34−--not so great orphan instance

3536instance Binary UTCTime where

3637 put utc = put $ toRational (utcTimeToPOSIXSeconds utc)

3738 get = do

@@ -57,6 +58,7 @@ data AtomType = StringAtomType |

5758 DateTimeAtomType |

5859 DateAtomType |

5960 DoubleAtomType |

61+ ByteStringAtomType |

6062 AnyAtomType --AnyAtomType is used as a wildcard

6163 deriving (Eq, Show, Generic)

6264

ProjectM36/Relation/Show/CSV.hs+19−14

@@ -16,7 +16,7 @@ relationAsCSV (Relation attrs tupleSet) = if relValAttrs /= [] then --check for

1616 else if V.length attrs == 0 then --check that there is at least one attribute

1717 Left $ TupleAttributeCountMismatchError 0

1818 else

19− Right $ encodeByName bsAttrNames (asList tupleSet)

19+ Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)

2020 where

2121 relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs

2222 bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

@@ -26,19 +26,24 @@ instance ToRecord RelationTuple where

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

2727-}

2828

29−instance ToNamedRecord RelationTuple where

30− toNamedRecord tuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= v) (tupleAssocs tuple)

29+newtype RecordRelationTuple = RecordRelationTuple {unTuple :: RelationTuple}

30+

31+instance ToNamedRecord RecordRelationTuple where

32+ toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= (RecordAtom v)) (tupleAssocs $ unTuple rTuple)

33+

34+instance DefaultOrdered RecordRelationTuple where

35+ headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (tupleAttributes tuple)

3136

32−instance DefaultOrdered RelationTuple where

33− headerOrder tuple = V.map (TE.encodeUtf8 . attributeName) (tupleAttributes tuple)

37+newtype RecordAtom = RecordAtom {unAtom :: Atom}

3438

35−instance ToField Atom where

36− toField (BoolAtom atom) = toField (if atom then "t" else "f")

37− toField (StringAtom atom) = toField atom

38− toField (IntAtom atom) = toField atom

39− toField (DateTimeAtom atom) = toField (show atom)

40− toField (DateAtom atom) = toField (show atom)

41− toField (DoubleAtom atom) = toField atom

42− toField (RelationAtom _) = error "Relation atoms cannot be used in CSV."

43−

39+instance ToField RecordAtom where

40+ toField ratom = case unAtom ratom of

41+ BoolAtom atom -> toField (if atom then "t" else "f")

42+ StringAtom atom -> toField atom

43+ IntAtom atom -> toField atom

44+ DateTimeAtom atom -> toField (show atom)

45+ DateAtom atom -> toField (show atom)

46+ DoubleAtom atom -> toField atom

47+ RelationAtom _ -> error "Relation atoms cannot be used in CSV."

48+ ByteStringAtom bs -> toField bs

4449

ProjectM36/Relation/Show/HTML.hs+2−1

@@ -3,12 +3,12 @@ module ProjectM36.Relation.Show.HTML where

33import ProjectM36.Base

44import ProjectM36.Relation

55import ProjectM36.Tuple

6−import qualified Data.HashSet as HS

76import qualified Data.List as L

87import ProjectM36.Attribute

98import Data.Text (append, Text, pack)

109import qualified Data.Text as T

1110import qualified Data.Text.IO as TIO

11+import qualified Data.Text.Encoding as TE

1212

1313attributesAsHTML :: Attributes -> Text

1414attributesAsHTML attrs = "<tr>" `append` (T.concat $ map oneAttrHTML attrNameList) `append` "</tr>"

@@ -35,6 +35,7 @@ atomAsHTML (BoolAtom bool) = pack (show bool)

3535atomAsHTML (DateTimeAtom dt) = pack (show dt)

3636atomAsHTML (DoubleAtom d) = pack (show d)

3737atomAsHTML (DateAtom d) = pack (show d)

38+atomAsHTML (ByteStringAtom bs) = TE.decodeUtf8 bs

3839

3940tupleAsHTML :: RelationTuple -> Text

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

ProjectM36/Relation/Show/Term.hs+2

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

77import qualified Data.Set as S

88import qualified Data.List as L

99import qualified Data.Text as T

10+import qualified Data.Text.Encoding as TE

1011

1112boxV :: StringType

1213boxV = "│"

@@ -98,6 +99,7 @@ showAtom (BoolAtom bool) = T.pack $ if bool then "t" else "f"

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

99100showAtom (DateAtom d) = T.pack $ show d

100101showAtom (DoubleAtom d) = T.pack $ show d

102+showAtom (ByteStringAtom bs) = TE.decodeUtf8 bs

101103

102104renderTable :: Table -> StringType

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

TutorialD/Interpreter/RelationalExpr.hs+15−1

@@ -15,6 +15,8 @@ import qualified Data.Set as S

1515import Data.Functor.Identity (Identity)

1616import Data.Time.Format

1717import Control.Applicative (liftA)

18+import Data.ByteString.Base64 as B64

19+import Data.Text.Encoding as TE

1820

1921atomTypeP :: Parser AtomType

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

@@ -23,6 +25,7 @@ atomTypeP = (reserved "char" *> return StringAtomType) <|>

2325 (reserved "date" *> return DateAtomType) <|>

2426 (reserved "double" *> return DoubleAtomType) <|>

2527 (reserved "bool" *> return BoolAtomType) <|>

28+ (reserved "bytestring" *> return ByteStringAtomType) <|>

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

2730

2831--used in projection

@@ -224,7 +227,8 @@ nakedAtomExprP :: Parser AtomExpr

224227nakedAtomExprP = NakedAtomExpr <$> atomP

225228

226229atomP :: Parser Atom

230+atomP = dateTimeAtomP <|> dateAtomP <|> byteStringAtomP <|>

231+ stringAtomP <|> doubleAtomP <|> intAtomP <|> boolAtomP <|> relationAtomP

228232

229233functionAtomExprP :: Parser AtomExpr

230234functionAtomExprP = do

@@ -272,6 +276,16 @@ boolAtomP = do

272276relationAtomP :: Parser Atom

273277relationAtomP = RelationAtom <$> relationP

274278

279+byteStringAtomP :: Parser Atom

280+byteStringAtomP = do

281+ byteString' <- try $ do

282+ byteString <- quotedString

283+ reserved "::bytestring"

284+ return byteString

285+ case B64.decode $ TE.encodeUtf8 (T.pack byteString') of

286+ Left err -> fail err

287+ Right bsVal -> return $ ByteStringAtom bsVal

288+

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

276290relationP :: Parser Relation

277291relationP = do

docs/tutd_tutorial.markdown+1

@@ -25,6 +25,7 @@ TutorialD is strongly-typed. The basic built-in types are:

2525|datetime|timestamp UTC|"2015-02-02 04:05:02"::datetime|

2626|double|floating point number|3.1459|

2727|bool|boolean value|t|

28+|bytestring|arbitrary-length string of bytes- input is base64-encoded|"dGVzdGRhdGE="::bytestring|

2829

2930With regards to boolean values, be sure not to conflate ```t``` or ```f``` as a boolean value with ```true``` and ```false``` which are relation variables.

3031

project-m36.cabal+1−1

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

77Cabal-Version: >= 1.2

99Library

10− Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava ==0.4.*,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,attoparsec,either, persistent,persistent-template,aeson,path-pieces,conduit,resourcet

10+ Build-Depends: base,mtl,containers,unordered-containers,parsec,hashable,haskeline,directory,uuid,cassava ==0.4.*,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,attoparsec,either,base64-bytestring, persistent,persistent-template,aeson,path-pieces,conduit,resourcet

1111--required for persistent db driver

1212 Exposed-Modules: ProjectM36.Error,

1313 ProjectM36.Transaction,

test/TutorialD/Interpreter.hs+5−1

@@ -17,6 +17,7 @@ import System.Exit

1717import Data.Maybe (isJust)

1818import System.IO

1919import qualified Data.Vector as V

20+import Data.Text.Encoding as TE

2021

2122--urgent: add group and ungroup tests- I missed the group relation type bug

2223main :: IO ()

@@ -58,6 +59,7 @@ main = do

5859 simpleBAttributes = A.attributesFromList [Attribute "d" IntAtomType]

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

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

62+ byteStringAttributes = A.attributesFromList [Attribute "y" ByteStringAtomType]

6163 simpleProjectionAttributes = A.attributesFromList [Attribute "c" IntAtomType]

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

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

@@ -88,7 +90,9 @@ main = do

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

8991 --test key syntax

9092 ("x:=S; key testconstraint {S#,CITY} x; insert x relation{tuple{CITY \"London\", S# \"S1\", SNAME \"gonk\", STATUS 50}}", Left (InclusionDependencyCheckError "testconstraint")),

91− ("y:=S; key testconstraint {S#} y; insert y relation{tuple{CITY \"London\", S# \"S6\", SNAME \"gonk\", STATUS 50}}; x:=y{S#} = S{S#} union relation{tuple{S# \"S6\"}}", Right $ relationTrue)

93+ ("y:=S; key testconstraint {S#} y; insert y relation{tuple{CITY \"London\", S# \"S6\", SNAME \"gonk\", STATUS 50}}; x:=y{S#} = S{S#} union relation{tuple{S# \"S6\"}}", Right $ relationTrue),

94+ --test binary bytestring data type

95+ ("x:=relation{tuple{y \"dGVzdGRhdGE=\"::bytestring}}", mkRelationFromList byteStringAttributes [[ByteStringAtom (TE.encodeUtf8 "testdata")]])

9296 ]

9397

9498