{-# LANGUAGE ScopedTypeVariables #-}
module GEODE.Metadata.TSV
  ( readNamedTsv
  , readTsv
  , toTsv
  , tsvFile
  , tsvLines ) where

import Data.ByteString.Lazy as ByteString (putStr, readFile, writeFile)
import Data.Csv
  ( DecodeOptions(..), EncodeOptions(..), FromNamedRecord(..), FromRecord
  , HasHeader(..), ToNamedRecord(..), ToRecord(..), decodeByNameWith
  , decodeWith, defaultEncodeOptions, encodeByNameWith, encodeWith )
import Data.Foldable (toList)
import Data.Vector (Vector)
import GEODE.Metadata.TSV.Header (HasDefaultHeader, getHeader, for)

readNamedTsv :: FromNamedRecord a => FilePath -> IO (Either String (Vector a))
readNamedTsv source =
  (fmap snd . decodeByNameWith fromTsv) <$> ByteString.readFile source
  where
    fromTsv = DecodeOptions {decDelimiter = fromIntegral (fromEnum '\t')}

readTsv :: FromRecord a => FilePath -> IO (Either String (Vector a))
readTsv source = decodeWith fromTsv NoHeader <$> ByteString.readFile source
  where
    fromTsv = DecodeOptions {decDelimiter = fromIntegral (fromEnum '\t')}

toTsv :: EncodeOptions
toTsv = defaultEncodeOptions
        { encDelimiter = fromIntegral (fromEnum '\t')
        , encUseCrLf = False }

tsvFile :: forall a t. (Foldable t, HasDefaultHeader a, ToNamedRecord a) =>
  FilePath -> t a -> IO ()
tsvFile target = ByteString.writeFile target . encode . toList
  where
    encode = encodeByNameWith toTsv (getHeader (for :: a))

tsvLines :: (Foldable t, ToRecord a) => t a -> IO ()
tsvLines = ByteString.putStr . encodeWith toTsv . toList