{-# OPTIONS_GHC -fno-warn-orphans #-}
module ProjectM36.Relation.Show.CSV where
import ProjectM36.Base
import ProjectM36.Attribute as A
import Data.Csv
import ProjectM36.Tuple
import qualified Data.ByteString.Lazy as BS
import qualified Data.Vector as V
import ProjectM36.Error
import qualified Data.Text.Encoding as TE
import ProjectM36.Atom
relationAsCSV :: Relation -> Either RelationalError BS.ByteString
relationAsCSV :: Relation -> Either RelationalError ByteString
relationAsCSV (Relation Attributes
attrs RelationTupleSet
tupleSet)
| [Attribute]
relValAttrs [Attribute] -> [Attribute] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] =
RelationalError -> Either RelationalError ByteString
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError ByteString)
-> RelationalError -> Either RelationalError ByteString
forall a b. (a -> b) -> a -> b
$ [AttributeName] -> RelationalError
RelationValuedAttributesNotSupportedError ((Attribute -> AttributeName) -> [Attribute] -> [AttributeName]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> AttributeName
attributeName [Attribute]
relValAttrs)
| Attributes -> Bool
A.null Attributes
attrs =
RelationalError -> Either RelationalError ByteString
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError ByteString)
-> RelationalError -> Either RelationalError ByteString
forall a b. (a -> b) -> a -> b
$ Int -> RelationalError
TupleAttributeCountMismatchError Int
0
| Bool
otherwise =
ByteString -> Either RelationalError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either RelationalError ByteString)
-> ByteString -> Either RelationalError ByteString
forall a b. (a -> b) -> a -> b
$ Header -> [RecordRelationTuple] -> ByteString
forall a. ToNamedRecord a => Header -> [a] -> ByteString
encodeByName Header
bsAttrNames ([RecordRelationTuple] -> ByteString)
-> [RecordRelationTuple] -> ByteString
forall a b. (a -> b) -> a -> b
$ (RelationTuple -> RecordRelationTuple)
-> [RelationTuple] -> [RecordRelationTuple]
forall a b. (a -> b) -> [a] -> [b]
map RelationTuple -> RecordRelationTuple
RecordRelationTuple (RelationTupleSet -> [RelationTuple]
asList RelationTupleSet
tupleSet)
where
relValAttrs :: [Attribute]
relValAttrs = Vector Attribute -> [Attribute]
forall a. Vector a -> [a]
V.toList (Vector Attribute -> [Attribute])
-> Vector Attribute -> [Attribute]
forall a b. (a -> b) -> a -> b
$ (Attribute -> Bool) -> Vector Attribute -> Vector Attribute
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (AtomType -> Bool
isRelationAtomType (AtomType -> Bool) -> (Attribute -> AtomType) -> Attribute -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> AtomType
atomType) (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
bsAttrNames :: Header
bsAttrNames = (Attribute -> ByteString) -> Vector Attribute -> Header
forall a b. (a -> b) -> Vector a -> Vector b
V.map (AttributeName -> ByteString
TE.encodeUtf8 (AttributeName -> ByteString)
-> (Attribute -> AttributeName) -> Attribute -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> AttributeName
attributeName) (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
newtype RecordRelationTuple = RecordRelationTuple {RecordRelationTuple -> RelationTuple
unTuple :: RelationTuple}
instance ToNamedRecord RecordRelationTuple where
toNamedRecord :: RecordRelationTuple -> NamedRecord
toNamedRecord RecordRelationTuple
rTuple = [(ByteString, ByteString)] -> NamedRecord
namedRecord ([(ByteString, ByteString)] -> NamedRecord)
-> [(ByteString, ByteString)] -> NamedRecord
forall a b. (a -> b) -> a -> b
$ ((AttributeName, Atom) -> (ByteString, ByteString))
-> [(AttributeName, Atom)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(AttributeName
k,Atom
v) -> AttributeName -> ByteString
TE.encodeUtf8 AttributeName
k ByteString -> RecordAtom -> (ByteString, ByteString)
forall a. ToField a => ByteString -> a -> (ByteString, ByteString)
.= Atom -> RecordAtom
RecordAtom Atom
v) (RelationTuple -> [(AttributeName, Atom)]
tupleAssocs (RelationTuple -> [(AttributeName, Atom)])
-> RelationTuple -> [(AttributeName, Atom)]
forall a b. (a -> b) -> a -> b
$ RecordRelationTuple -> RelationTuple
unTuple RecordRelationTuple
rTuple)
instance DefaultOrdered RecordRelationTuple where
headerOrder :: RecordRelationTuple -> Header
headerOrder (RecordRelationTuple RelationTuple
tuple) = (Attribute -> ByteString) -> Vector Attribute -> Header
forall a b. (a -> b) -> Vector a -> Vector b
V.map (AttributeName -> ByteString
TE.encodeUtf8 (AttributeName -> ByteString)
-> (Attribute -> AttributeName) -> Attribute -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> AttributeName
attributeName) (Attributes -> Vector Attribute
attributesVec (RelationTuple -> Attributes
tupleAttributes RelationTuple
tuple))
newtype RecordAtom = RecordAtom {RecordAtom -> Atom
unAtom :: Atom}
instance ToField RecordAtom where
toField :: RecordAtom -> ByteString
toField (RecordAtom (TextAtom AttributeName
atomVal)) = AttributeName -> ByteString
TE.encodeUtf8 AttributeName
atomVal
toField (RecordAtom Atom
atomVal) = (AttributeName -> ByteString
TE.encodeUtf8 (AttributeName -> ByteString)
-> (Atom -> AttributeName) -> Atom -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Atom -> AttributeName
atomToText) Atom
atomVal