70 lines
2.7 KiB
Haskell
70 lines
2.7 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Utils.Csv.Mail
|
|
( recodeCsv
|
|
) where
|
|
|
|
import Import.NoModel
|
|
import Model.Types.Csv
|
|
|
|
import qualified Data.Csv as Csv
|
|
|
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
|
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
import Data.Encoding (encodeLazyByteStringExplicit, decodeLazyByteStringExplicit)
|
|
|
|
|
|
instance (RenderMessage site msg, YesodMail site) => ToMailPart site (msg, CsvRendered) where
|
|
toMailPart (sheetName, csvRendered@CsvRendered{..}) = do
|
|
encOpts <- lift askMailCsvOptions
|
|
|
|
case encOpts ^. _csvFormat of
|
|
CsvFormatOptions{}
|
|
| Just csvOpts <- encOpts ^? _csvFormat . _CsvEncodeOptions -> do
|
|
_partType .= decodeUtf8 typeCsv'
|
|
_partEncoding .= QuotedPrintableText
|
|
_partContent <~ fmap PartContent (liftHandler . runConduit $ C.sourceLazy (Csv.encodeByNameWith csvOpts csvRenderedHeader csvRenderedData) .| recodeCsv encOpts True C.sinkLazy)
|
|
| otherwise -> error "encOpts is CsvFormatOptions but cannot be converted via _CsvEncodeOptions"
|
|
CsvXlsxFormatOptions{} -> do
|
|
pNow <- liftIO getPOSIXTime
|
|
sheetName' <- lift $ ($ sheetName) <$> getMailMessageRender
|
|
_partType .= decodeUtf8 typeXlsx
|
|
_partEncoding .= Base64
|
|
_partContent .= PartContent (fromXlsx pNow $ csvRenderedToXlsx sheetName' csvRendered)
|
|
|
|
recodeCsv :: MonadThrow m
|
|
=> CsvOptions
|
|
-> Bool -- ^ recode from (internal) utf8 to user chosen coding?
|
|
-> ConduitT ByteString o m a -> ConduitT ByteString o m a
|
|
recodeCsv encOpts toUser act = fromMaybe act $ do
|
|
enc <- encOpts ^? _csvFormat . _csvEncoding
|
|
|
|
let
|
|
recode
|
|
| toUser = either throwM return . encodeLazyByteStringExplicit enc <=< either throwM return . decodeLazyByteStringExplicit UTF8
|
|
| otherwise = either throwM return . encodeLazyByteStringExplicit UTF8 <=< either throwM return . decodeLazyByteStringExplicit enc
|
|
|
|
return $ if
|
|
| enc == "UTF8" -> act
|
|
| FormatCsv <- fmt -> do
|
|
inp <- C.sinkLazy
|
|
inp' <- recode inp
|
|
sourceLazy inp' .| act
|
|
-- | FormatXlsx <- fmt -> do
|
|
-- inp <- C.sinkLazy
|
|
-- archive <- throwLeft $ Zip.toArchiveOrFail inp
|
|
-- archive' <- traverseOf (_zEntries . traverse . _Entrty . _3) recode archive
|
|
-- sourceLazy (Zip.fromArchive inp') .| act
|
|
| otherwise -> act
|
|
where
|
|
|
|
fmt = encOpts ^. _csvFormat . _CsvFormat
|
|
|
|
-- _zEntries :: Lens' Zip.Archive [Zip.Entry]
|
|
-- _zEntries = lens (\Zip.Archive{..} -> zEntries) (\archive entries -> archive { zEntries = entries })
|
|
|
|
-- _Entry :: Lens' Zip.Entry (FilePath, Integer, Lazy.ByteString)
|
|
-- _Entry = lens (\entry@Zip.Entry{..} -> (eRelativePath, eLastModified, Zip.fromEntry entry)) (uncurry3 Zip.toEntry)
|