9e727a1 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

switch to using NamedRecord for CSV export which I should have used in the first place

9e727a1AgentM11 years ago

ProjectM36/Client.hs+1−4

compare with master

unifiedsplit

@@ -9,7 +9,6 @@ import ProjectM36.TransactionGraph

9import ProjectM36.TransactionGraph.Persist

10import Data.UUID.V4 (nextRandom)

11import Control.Concurrent.STM

12−import qualified Data.Map as M

13import Data.Word

12import Data.Word

15type DatabaseName = StringType

14type DatabaseName = StringType

@@ -32,9 +31,7 @@ connectProjectM36 :: ConnectionInfo -> IO (Either ConnectionError Connection)

32--create a new in-memory database/transaction graph

31--create a new in-memory database/transaction graph

33connectProjectM36 (InProcessConnectionInfo strat) = do

32connectProjectM36 (InProcessConnectionInfo strat) = do

34 freshUUID <- nextRandom

33 freshUUID <- nextRandom

35− let bootstrapContext = DatabaseContext { inclusionDependencies = M.empty,

34+ let bootstrapContext = basicDatabaseContext

36− relationVariables = M.empty,

37− atomFunctions = basicAtomFunctions }

38 freshDiscon = newDisconnectedTransaction freshUUID bootstrapContext

35 freshDiscon = newDisconnectedTransaction freshUUID bootstrapContext

39 freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext

36 freshGraph = bootstrapTransactionGraph freshUUID bootstrapContext

40 case strat of

37 case strat of

ProjectM36/DatabaseContext.hs+2−1

@@ -6,4 +6,5 @@ import qualified Data.HashSet as HS

6empty :: DatabaseContext

7empty = DatabaseContext { inclusionDependencies = M.empty,

8 relationVariables = M.empty,

9− atomFunctions = HS.empty }

9+ atomFunctions = HS.empty }

10+

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

@@ -5,27 +5,34 @@ import Data.Csv

5import ProjectM36.Tuple

6import qualified Data.HashSet as HS

7import qualified Data.ByteString.Lazy as BS

8+import qualified Data.ByteString as BSS

8import qualified Data.Vector as V

9import qualified Data.Vector as V

9import ProjectM36.Error

10import ProjectM36.Error

10import qualified Data.Text.Encoding as TE

11import qualified Data.Text.Encoding as TE

11import qualified Data.Text as T

12import qualified Data.Text as T

13−--maybe support a header in the future

14+--spit out error for relations without attributes (since relTrue and relFalse cannot be distinguished then as CSV) and for relations with relation-valued attributes

14relationAsCSV :: Relation -> Either RelationalError BS.ByteString

15relationAsCSV :: Relation -> Either RelationalError BS.ByteString

15−relationAsCSV (Relation attrs tupleSet) = case relValAttrs of

16+relationAsCSV (Relation attrs tupleSet) = if relValAttrs /= [] then --check for relvalued attributes

16− [] -> Right $ encodeHeader `BS.append` tupleSetAsCSV tupleSet

17− attrs' -> Left $ RelationValuedAttributesNotSupportedError (map attributeName attrs')

17+ Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)

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

19+ Left $ TupleAttributeCountMismatchError 0

20+ else

21+ Right $ encodeByName bsAttrNames (HS.toList tupleSet)

18 where

22 where

19− --figure out how to make cassava responsible for printing the header even for non-named records or make NamedRecord instance for RelationTuple ?

20− -- this will break on attribute names which need quoting

21− encodeHeader = (BS.intercalate (BS.fromStrict . TE.encodeUtf8 . T.pack $ ",") $ V.toList $ V.map (BS.fromStrict . TE.encodeUtf8 . attributeName) attrs) `BS.append` (BS.fromStrict . TE.encodeUtf8 . T.pack) "\n"

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

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

23−

24+ bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

24−tupleSetAsCSV :: RelationTupleSet -> BS.ByteString

25+

25−tupleSetAsCSV tupleSet = encode (HS.toList tupleSet)

26+{-

26−

27instance ToRecord RelationTuple where

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

29+-}

30+

31+instance ToNamedRecord RelationTuple where

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

33+

34+instance DefaultOrdered RelationTuple where

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

30instance ToField Atom where

37instance ToField Atom where

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

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

@@ -34,6 +41,6 @@ instance ToField Atom where

34 toField (DateTimeAtom atom) = toField (show atom)

41 toField (DateTimeAtom atom) = toField (show atom)

35 toField (DateAtom atom) = toField (show atom)

42 toField (DateAtom atom) = toField (show atom)

36 toField (DoubleAtom atom) = toField atom

43 toField (DoubleAtom atom) = toField atom

37− toField (RelationAtom _) = undefined -- CSV does not support nested relations

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

ProjectM36/Tuple.hs+3

@@ -22,6 +22,9 @@ tupleAttributeNameSet (RelationTuple tupAttrs _) = S.fromList $ V.toList $ V.map

22tupleAttributes :: RelationTuple -> Attributes

23tupleAttributes (RelationTuple tupAttrs _) = tupAttrs

25+tupleAssocs :: RelationTuple -> [(AttributeName, Atom)]

26+tupleAssocs (RelationTuple attrVec tupVec) = V.toList $ V.map (\(k,v) -> (attributeName k, v)) (V.zip attrVec tupVec)

27+

25-- return atoms in some arbitrary but consistent key order

28-- return atoms in some arbitrary but consistent key order

26tupleAtoms :: RelationTuple -> V.Vector Atom

29tupleAtoms :: RelationTuple -> V.Vector Atom

27tupleAtoms (RelationTuple _ tupVec) = tupVec

30tupleAtoms (RelationTuple _ tupVec) = tupVec