{-# 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

--spit out error for relations without attributes (since relTrue and relFalse cannot be distinguished then as CSV) and for relations with relation-valued attributes
relationAsCSV :: Relation -> Either RelationalError BS.ByteString
relationAsCSV :: Relation -> Either RelationalError ByteString
relationAsCSV (Relation Attributes
attrs RelationTupleSet
tupleSet)  
 --check for relvalued attributes
  | [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)
 --check that there is at least one attribute    
  | 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)

{-
instance ToRecord RelationTuple where
  toRecord tuple = toRecord $ map toField (V.toList $ tupleAtoms tuple)
-}

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 --without this, CSV text atoms are doubly quoted
  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