{-# OPTIONS_GHC -fno-warn-orphans #-}

module Handler.Utils.Csv
  ( typeCsv, extensionCsv
  , decodeCsv
  , encodeCsv
  , respondCsv, respondCsvDB
  , fileSourceCsv
  , CsvParseError(..)
  , ToNamedRecord(..), FromNamedRecord(..)
  , DefaultOrdered(..)
  , ToField(..), FromField(..)
  ) where

import Import

import Data.Csv
import Data.Csv.Conduit

import qualified Data.Conduit.List as C
import qualified Data.Conduit.Combinators as C (sourceLazy)

import qualified Data.Map as Map


deriving instance Typeable CsvParseError
instance Exception CsvParseError


typeCsv :: ContentType
typeCsv = "text/csv"

extensionCsv :: Extension
extensionCsv = fromMaybe "csv" $ listToMaybe [ ext | (ext, mime) <- Map.toList mimeMap, mime == typeCsv ]


decodeCsv :: (MonadThrow m, FromNamedRecord csv) => Conduit ByteString m csv
decodeCsv = transPipe throwExceptT $ fromNamedCsv defaultDecodeOptions

encodeCsv :: ( ToNamedRecord csv
             , DefaultOrdered csv
             , Monad m
             )
          => Conduit csv m ByteString
-- ^ Encode a stream of records
--
-- Currently not streaming
encodeCsv = fmap encodeDefaultOrderedByName (C.foldMap pure) >>= C.sourceLazy

  
respondCsv :: ( ToNamedRecord csv
              , DefaultOrdered csv
              )
           => Source (HandlerT site IO) csv
           -> HandlerT site IO TypedContent
respondCsv src = respondSource typeCsv $ src .| encodeCsv .| awaitForever sendChunk

respondCsvDB :: ( ToNamedRecord csv
                , DefaultOrdered csv
                , YesodPersistRunner site
                )
             => Source (YesodDB site) csv
             -> HandlerT site IO TypedContent
respondCsvDB src = respondSourceDB typeCsv $ src .| encodeCsv .| awaitForever sendChunk

fileSourceCsv :: ( FromNamedRecord csv
                 , MonadResource m
                 )
              => FileInfo
              -> Source m csv
fileSourceCsv = (.| decodeCsv) . fileSource