fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

versionbump: Removed one error in src/Model/Types/Csv.hs

Browse Source
This commit is contained in:
Stephan Barth 2024-02-11 18:05:43 +01:00
parent ade5ae89d0
commit fb5f19cb8d
1 changed files with 31 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
src/Model/Types/Csv.hs
View File

@ -58,6 +58,31 @@ data CsvPreset = CsvPresetRFC
instance Universe CsvPreset instance Universe CsvPreset
instance Finite 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 instance Default CsvFormatOptions where
def = csvPreset # CsvPresetRFC -- DO NOT CHANGE! def = csvPreset # CsvPresetRFC -- DO NOT CHANGE!
-- Changing the default to CsvPresetXlsx will cause internal server errors due to partial record selectors failing, like `csvIncludeHeader` -- 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 pathPieceJSON ''CsvFormat
makePrisms ''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 :: forall r. Getting r CsvFormatOptions CsvFormat
_CsvFormat = to $ \case _CsvFormat = to $ \case
@ -183,11 +183,12 @@ _CsvEncodeOptions = prism' fromEncode toEncode
, Csv.encIncludeHeader = csvIncludeHeader , Csv.encIncludeHeader = csvIncludeHeader
} }
toEncode CsvXlsxFormatOptions{} = Nothing toEncode CsvXlsxFormatOptions{} = Nothing
fromEncode encOpts = def fromEncode encOpts = case def of
{ csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts CsvXlsxFormatOptions -> error "Default value for CsvFormatOptions shall not be CsvXlsxFormatOptions but it seems that it is!"
, csvUseCrLf = Csv.encUseCrLf encOpts p@CsvFormatOptions{} -> p { csvDelimiter = toEnum . fromIntegral $ Csv.encDelimiter encOpts
, csvQuoting = Csv.encQuoting encOpts , csvUseCrLf = Csv.encUseCrLf encOpts
} , csvQuoting = Csv.encQuoting encOpts
}
instance ToJSON CsvOptions where instance ToJSON CsvOptions where
toJSON CsvOptions{..} = JSON.object toJSON CsvOptions{..} = JSON.object