diff --git a/src/Model/Types/Csv.hs b/src/Model/Types/Csv.hs index 5f01a46c0..7e8a03a11 100644 --- a/src/Model/Types/Csv.hs +++ b/src/Model/Types/Csv.hs @@ -58,6 +58,31 @@ data CsvPreset = CsvPresetRFC instance Universe CsvPreset instance Finite CsvPreset +csvPreset :: Prism' CsvFormatOptions CsvPreset +csvPreset = prism' fromPreset toPreset + where + fromPreset :: CsvPreset -> CsvFormatOptions + fromPreset CsvPresetRFC = CsvFormatOptions + { csvDelimiter = ',' + , csvUseCrLf = True + , csvIncludeHeader = True + , csvQuoting = QuoteMinimal + , csvEncoding = "UTF8" + } + fromPreset CsvPresetExcel = CsvFormatOptions + { csvDelimiter = ';' + , csvUseCrLf = True + , csvIncludeHeader = True + , csvQuoting = QuoteAll + , csvEncoding = "CP1252" + } + fromPreset CsvPresetXlsx = CsvXlsxFormatOptions + + toPreset :: CsvFormatOptions -> Maybe CsvPreset + toPreset opts = case filter (\p -> fromPreset p == opts) universeF of + [p] -> Just p + _other -> 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` @@ -85,31 +110,6 @@ nullaryPathPiece ''CsvFormat $ camelToPathPiece' 1 pathPieceJSON ''CsvFormat makePrisms ''CsvFormat -csvPreset :: Prism' CsvFormatOptions CsvPreset -csvPreset = prism' fromPreset toPreset - where - fromPreset :: CsvPreset -> CsvFormatOptions - fromPreset CsvPresetRFC = CsvFormatOptions - { csvDelimiter = ',' - , csvUseCrLf = True - , csvIncludeHeader = True - , csvQuoting = QuoteMinimal - , csvEncoding = "UTF8" - } - fromPreset CsvPresetExcel = CsvFormatOptions - { csvDelimiter = ';' - , csvUseCrLf = True - , csvIncludeHeader = True - , csvQuoting = QuoteAll - , csvEncoding = "CP1252" - } - fromPreset CsvPresetXlsx = CsvXlsxFormatOptions - - toPreset :: CsvFormatOptions -> Maybe CsvPreset - toPreset opts = case filter (\p -> fromPreset p == opts) universeF of - [p] -> Just p - _other -> Nothing - _CsvFormat :: forall r. Getting r CsvFormatOptions CsvFormat _CsvFormat = to $ \case @@ -183,11 +183,12 @@ _CsvEncodeOptions = prism' fromEncode toEncode , Csv.encIncludeHeader = csvIncludeHeader } toEncode CsvXlsxFormatOptions{} = Nothing - fromEncode encOpts = def - { csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts - , csvUseCrLf = Csv.encUseCrLf encOpts - , csvQuoting = Csv.encQuoting encOpts - } + fromEncode encOpts = case def of + CsvXlsxFormatOptions -> error "Default value for CsvFormatOptions shall not be CsvXlsxFormatOptions but it seems that it is!" + p@CsvFormatOptions{} -> p { csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts + , csvUseCrLf = Csv.encUseCrLf encOpts + , csvQuoting = Csv.encQuoting encOpts + } instance ToJSON CsvOptions where toJSON CsvOptions{..} = JSON.object