CSV.hs

{-# OPTIONS_GHC -fno-warn-orphans #-}
module ProjectM36.Relation.Show.CSV where
import ProjectM36.Base
import ProjectM36.Attribute
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 attrs tupleSet)  
 --check for relvalued attributes
  | relValAttrs /= [] = 
    Left $ RelationValuedAttributesNotSupportedError (map attributeName relValAttrs)
 --check that there is at least one attribute    
  | V.null attrs =
      Left $ TupleAttributeCountMismatchError 0
  | otherwise = 
    Right $ encodeByName bsAttrNames $ map RecordRelationTuple (asList tupleSet)
  where
    relValAttrs = V.toList $ V.filter (isRelationAtomType . atomType) attrs
    bsAttrNames = V.map (TE.encodeUtf8 . attributeName) attrs

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

newtype RecordRelationTuple = RecordRelationTuple {unTuple :: RelationTuple}

instance ToNamedRecord RecordRelationTuple where  
  toNamedRecord rTuple = namedRecord $ map (\(k,v) -> TE.encodeUtf8 k .= RecordAtom v) (tupleAssocs $ unTuple rTuple)
  
instance DefaultOrdered RecordRelationTuple where  
  headerOrder (RecordRelationTuple tuple) = V.map (TE.encodeUtf8 . attributeName) (tupleAttributes tuple)
  
newtype RecordAtom = RecordAtom {unAtom :: Atom}
      
instance ToField RecordAtom where
  toField (RecordAtom (TextAtom atomVal)) = TE.encodeUtf8 atomVal --without this, CSV text atoms are doubly quoted
  toField (RecordAtom atomVal) = (TE.encodeUtf8 . atomToText) atomVal