Versionbump: Reordered src/Model/Types/Csv.hs so it compiles again.

This commit is contained in:
Stephan Barth 2024-02-11 17:16:07 +01:00
parent 861fa9d4a5
commit ade5ae89d0

View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
-- SPDX-FileCopyrightText: 2024 Stephan Barth <stephan.barth@uniworx.de>, 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
--
-- 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