From ade5ae89d070ff90d81ccd9850f3834a0f7f98e2 Mon Sep 17 00:00:00 2001 From: Stephan Barth Date: Sun, 11 Feb 2024 17:16:07 +0100 Subject: [PATCH] Versionbump: Reordered src/Model/Types/Csv.hs so it compiles again. --- src/Model/Types/Csv.hs | 158 +++++++++++++++++++++-------------------- 1 file changed, 81 insertions(+), 77 deletions(-) diff --git a/src/Model/Types/Csv.hs b/src/Model/Types/Csv.hs index 159339062..5f01a46c0 100644 --- a/src/Model/Types/Csv.hs +++ b/src/Model/Types/Csv.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost +-- SPDX-FileCopyrightText: 2024 Stephan Barth , 2022 Gregor Kleen ,Sarah Vaupel ,Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later @@ -39,6 +39,29 @@ import Utils.Lens.TH import Data.Default import Data.Universe +data CsvFormatOptions + = CsvFormatOptions + { csvDelimiter :: Char + , csvUseCrLf :: Bool + , csvQuoting :: Csv.Quoting + , csvEncoding :: DynEncoding + , csvIncludeHeader :: Bool + } + | CsvXlsxFormatOptions + deriving (Eq, Ord, Read, Show, Generic) + deriving anyclass (Hashable, NFData) + +data CsvPreset = CsvPresetRFC + | CsvPresetXlsx + | CsvPresetExcel + deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) +instance Universe CsvPreset +instance Finite CsvPreset + +instance Default CsvFormatOptions where + def = csvPreset # CsvPresetRFC -- DO NOT CHANGE! + -- Changing the default to CsvPresetXlsx will cause internal server errors due to partial record selectors failing, like `csvIncludeHeader` + deriving stock instance Generic Quoting deriving stock instance Ord Quoting @@ -53,47 +76,14 @@ nullaryPathPiece ''Quoting $ \q -> if | q == "QuoteNone" -> "never" | otherwise -> camelToPathPiece' 1 q -data CsvOptions - = CsvOptions - { csvFormat :: CsvFormatOptions - , csvTimestamp :: Bool - , csvExportLabel :: Maybe Text - } - deriving (Eq, Ord, Read, Show, Generic) - deriving anyclass (Hashable, NFData) -data CsvFormatOptions - = CsvFormatOptions - { csvDelimiter :: Char - , csvUseCrLf :: Bool - , csvQuoting :: Csv.Quoting - , csvEncoding :: DynEncoding - , csvIncludeHeader :: Bool - } - | CsvXlsxFormatOptions - deriving (Eq, Ord, Read, Show, Generic) - deriving anyclass (Hashable, NFData) - -makeLenses_ ''CsvOptions -makeLenses_ ''CsvFormatOptions - -instance Default CsvOptions where - def = CsvOptions - { csvFormat = def - , csvTimestamp = False - , csvExportLabel = Nothing - } - -instance Default CsvFormatOptions where - def = csvPreset # CsvPresetRFC -- DO NOT CHANGE! - -- Changing the default to CsvPresetXlsx will cause internal server errors due to partial record selectors failing, like `csvIncludeHeader` - -data CsvPreset = CsvPresetRFC - | CsvPresetXlsx - | CsvPresetExcel +data CsvFormat = FormatCsv | FormatXlsx deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) -instance Universe CsvPreset -instance Finite CsvPreset + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''CsvFormat $ camelToPathPiece' 1 +pathPieceJSON ''CsvFormat +makePrisms ''CsvFormat csvPreset :: Prism' CsvFormatOptions CsvPreset csvPreset = prism' fromPreset toPreset @@ -120,43 +110,6 @@ csvPreset = prism' fromPreset toPreset [p] -> Just p _other -> Nothing -_CsvEncodeOptions :: Prism' CsvFormatOptions Csv.EncodeOptions -_CsvEncodeOptions = prism' fromEncode toEncode - where - toEncode CsvFormatOptions{..} = Just $ Csv.defaultEncodeOptions - { Csv.encDelimiter = fromIntegral $ fromEnum csvDelimiter - , Csv.encUseCrLf = csvUseCrLf - , Csv.encQuoting = csvQuoting - , Csv.encIncludeHeader = csvIncludeHeader - } - toEncode CsvXlsxFormatOptions{} = Nothing - fromEncode encOpts = def - { csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts - , csvUseCrLf = Csv.encUseCrLf encOpts - , csvQuoting = Csv.encQuoting encOpts - } - -instance ToJSON CsvOptions where - toJSON CsvOptions{..} = JSON.object - [ "format" JSON..= csvFormat - , "timestamp" JSON..= csvTimestamp - , "export-label" JSON..= csvExportLabel - ] - -instance FromJSON CsvOptions where - parseJSON = JSON.withObject "CsvOptions" $ \o -> do - csvFormat <- o JSON..:? "format" JSON..!= csvFormat def - csvTimestamp <- o JSON..:? "timestamp" JSON..!= csvTimestamp def - csvExportLabel <- o JSON..:? "export-label" JSON..!= csvExportLabel def - return CsvOptions{..} - -data CsvFormat = FormatCsv | FormatXlsx - deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) - deriving anyclass (Universe, Finite) - -nullaryPathPiece ''CsvFormat $ camelToPathPiece' 1 -pathPieceJSON ''CsvFormat -makePrisms ''CsvFormat _CsvFormat :: forall r. Getting r CsvFormatOptions CsvFormat _CsvFormat = to $ \case @@ -199,6 +152,57 @@ instance FromJSON CsvFormatOptions where return CsvFormatOptions{..} FormatXlsx -> return CsvXlsxFormatOptions + +data CsvOptions + = CsvOptions + { csvFormat :: CsvFormatOptions + , csvTimestamp :: Bool + , csvExportLabel :: Maybe Text + } + deriving (Eq, Ord, Read, Show, Generic) + deriving anyclass (Hashable, NFData) + +makeLenses_ ''CsvOptions +makeLenses_ ''CsvFormatOptions + +instance Default CsvOptions where + def = CsvOptions + { csvFormat = def + , csvTimestamp = False + , csvExportLabel = Nothing + } + + +_CsvEncodeOptions :: Prism' CsvFormatOptions Csv.EncodeOptions +_CsvEncodeOptions = prism' fromEncode toEncode + where + toEncode CsvFormatOptions{..} = Just $ Csv.defaultEncodeOptions + { Csv.encDelimiter = fromIntegral $ fromEnum csvDelimiter + , Csv.encUseCrLf = csvUseCrLf + , Csv.encQuoting = csvQuoting + , Csv.encIncludeHeader = csvIncludeHeader + } + toEncode CsvXlsxFormatOptions{} = Nothing + fromEncode encOpts = def + { csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts + , csvUseCrLf = Csv.encUseCrLf encOpts + , csvQuoting = Csv.encQuoting encOpts + } + +instance ToJSON CsvOptions where + toJSON CsvOptions{..} = JSON.object + [ "format" JSON..= csvFormat + , "timestamp" JSON..= csvTimestamp + , "export-label" JSON..= csvExportLabel + ] + +instance FromJSON CsvOptions where + parseJSON = JSON.withObject "CsvOptions" $ \o -> do + csvFormat <- o JSON..:? "format" JSON..!= csvFormat def + csvTimestamp <- o JSON..:? "timestamp" JSON..!= csvTimestamp def + csvExportLabel <- o JSON..:? "export-label" JSON..!= csvExportLabel def + return CsvOptions{..} + derivePersistFieldJSON ''CsvOptions nullaryPathPiece ''CsvPreset $ camelToPathPiece' 2