72 lines
1.9 KiB
Haskell
72 lines
1.9 KiB
Haskell
{-# 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
|