{-# LANGUAGE CPP, FlexibleContexts #-}
module WeekDaze.OutputConfiguration.Options(
NDecimalDigits,
Options(
getFileFormats,
getMaybeOutputConfigFilePath,
getNDecimalDigits,
getStudentBodyMnemonicSeparator,
getVerbosity
),
nDecimalDigitsTag,
outputConfigFilePathTag,
mkOptions
) where
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Data.List.Extra
import qualified Data.Maybe
import qualified Distribution.Verbosity
import qualified System.FilePath
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
import qualified WeekDaze.Aggregate.StudentClass as Aggregate.StudentClass
import qualified WeekDaze.OutputConfiguration.FileFormat as OutputConfiguration.FileFormat
#ifdef USE_HDBC
import qualified Database.HDBC
import qualified WeekDaze.Database.Selector as Database.Selector
import qualified WeekDaze.OutputConfiguration.Format as OutputConfiguration.Format
import qualified WeekDaze.OutputConfiguration.Verbosity as OutputConfiguration.Verbosity
instance (Fractional minimumContrastRatio, Show minimumContrastRatio) => Database.Selector.Selector (Options minimumContrastRatio) where
fromDatabase connection projectIdSql = let
tableName :: Database.Selector.TableName
tableName = Database.Selector.tablePrefix ++ tag
in do
optionsRows <- Database.Selector.select connection [
nDecimalDigitsTag,
studentBodyMnemonicSeparatorTag,
OutputConfiguration.Verbosity.tag
] [tableName] [(Database.Selector.projectIdColumnName, projectIdSql)]
let
options' = case optionsRows of
[] -> Data.Default.def
[optionsRow] -> case optionsRow of
[nDecimalDigitsSql, mnemonicSeparatorSql, verbositySql] -> (
\options -> Data.Maybe.maybe options (
\s -> options { getStudentBodyMnemonicSeparator = s }
) $ Database.HDBC.fromSql mnemonicSeparatorSql
) $ Data.Default.def {
getNDecimalDigits = either (
error . showString "WeekDaze.OutputConfiguration.Options.fromDatabase:\tfailed to parse the value for " . shows nDecimalDigitsTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql nDecimalDigitsSql,
getVerbosity = Database.HDBC.fromSql verbositySql
}
_ -> error $ "WeekDaze.OutputConfiguration.Options.fromDatabase:\tunexpected number of columns=" ++ show (length optionsRow) ++ " in row of table " ++ show tableName ++ "."
_ -> error $ "WeekDaze.OutputConfiguration.Options.fromDatabase:\tunexpected number of rows=" ++ show (length optionsRows) ++ " selected from table " ++ show tableName ++ "."
style <- Database.Selector.fromDatabase connection projectIdSql
return options' {
getFileFormats = [OutputConfiguration.FileFormat.mkFileFormat OutputConfiguration.FileFormat.stdoutProxy $ OutputConfiguration.Format.XHTML style]
}
#else
import WeekDaze.OutputConfiguration.Verbosity()
#endif /* USE_HDBC */
tag :: String
tag = "outputOptions"
fileFormatsTag :: String
fileFormatsTag = "fileFormats"
nDecimalDigitsTag :: String
nDecimalDigitsTag = "nDecimalDigits"
outputConfigFilePathTag :: String
outputConfigFilePathTag = "outputConfigFilePath"
studentBodyMnemonicSeparatorTag :: String
studentBodyMnemonicSeparatorTag = "studentBodyMnemonicSeparator"
type NDecimalDigits = Int
data Options minimumContrastRatio = MkOptions {
getFileFormats :: [OutputConfiguration.FileFormat.FileFormat minimumContrastRatio],
getMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath,
getNDecimalDigits :: NDecimalDigits,
getStudentBodyMnemonicSeparator :: Aggregate.StudentClass.MnemonicSeparator,
getVerbosity :: Distribution.Verbosity.Verbosity
} deriving (Eq, Show)
instance Show minimumContrastRatio => ToolShed.SelfValidate.SelfValidator (Options minimumContrastRatio) where
getErrors MkOptions {
getFileFormats = fileFormats,
getMaybeOutputConfigFilePath = maybeOutputConfigFilePath,
getNDecimalDigits = nDecimalDigits
} = ToolShed.SelfValidate.extractErrors [
let
incompatibleFileFormats = filter ((/= 1) . length) $ Data.List.Extra.groupSortOn OutputConfiguration.FileFormat.getFilePath fileFormats
in (
not $ null incompatibleFileFormats,
"duplicate file-paths; " ++ show incompatibleFileFormats
), (
Data.Maybe.maybe False (not . System.FilePath.isValid ) maybeOutputConfigFilePath,
"invalid path to output config-file; " ++ show (Data.Maybe.fromJust maybeOutputConfigFilePath)
), (
nDecimalDigits < 1,
show nDecimalDigitsTag ++ "=" ++ show nDecimalDigits ++ ", must exceed zero"
),
let
maxNDecimalDigits = floor $ fromIntegral (
floatDigits (
undefined :: Double
)
) * (logBase 10 2 :: Double)
in (
nDecimalDigits > maxNDecimalDigits,
nDecimalDigitsTag ++ "=" ++ show nDecimalDigits ++ ", shouldn't exceed " ++ show maxNDecimalDigits
)
]
instance Data.Default.Default (Options minimumContrastRatio) where
def = MkOptions {
getFileFormats = [Data.Default.def],
getMaybeOutputConfigFilePath = Nothing,
getNDecimalDigits = 3,
getStudentBodyMnemonicSeparator = " / ",
getVerbosity = Data.Default.def
}
instance Control.DeepSeq.NFData minimumContrastRatio => Control.DeepSeq.NFData (Options minimumContrastRatio) where
rnf (MkOptions x0 x1 x2 x3 x4) = Control.DeepSeq.rnf (x0, x1, x2, x3, x4)
mkOptions
:: Show minimumContrastRatio
=> [OutputConfiguration.FileFormat.FileFormat minimumContrastRatio]
-> Maybe System.FilePath.FilePath
-> NDecimalDigits
-> Aggregate.StudentClass.MnemonicSeparator
-> Distribution.Verbosity.Verbosity
-> Options minimumContrastRatio
mkOptions fileFormats maybeOutputConfigFilePath nDecimalDigits studentBodyMnemonicSeparator verbosity
| ToolShed.SelfValidate.isValid options = options
| otherwise = error $ "WeekDaze.OutputConfiguration.Options.mkOptions:\t" ++ ToolShed.SelfValidate.getFirstError options ++ "."
where
options = MkOptions fileFormats maybeOutputConfigFilePath nDecimalDigits studentBodyMnemonicSeparator verbosity
instance (
Fractional minimumContrastRatio,
HXT.XmlPickler minimumContrastRatio,
Ord minimumContrastRatio,
Show minimumContrastRatio
) => HXT.XmlPickler (Options minimumContrastRatio) where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d, e) -> mkOptions a b c d e,
\MkOptions {
getFileFormats = fileFormats,
getMaybeOutputConfigFilePath = maybeOutputConfigFilePath,
getNDecimalDigits = nDecimalDigits,
getStudentBodyMnemonicSeparator = studentBodyMnemonicSeparator,
getVerbosity = verbosity
} -> (fileFormats, maybeOutputConfigFilePath, nDecimalDigits, studentBodyMnemonicSeparator, verbosity)
) $ HXT.xp5Tuple (
HXT.xpDefault (getFileFormats defaultOptions) . HXT.xpElem fileFormatsTag $ HXT.xpList1 HXT.xpickle
) (
HXT.xpOption $ HXT.xpTextAttr outputConfigFilePathTag
) (
getNDecimalDigits defaultOptions `HXT.xpDefault` HXT.xpAttr nDecimalDigitsTag HXT.xpInt
) (
getStudentBodyMnemonicSeparator defaultOptions `HXT.xpDefault` HXT.xpAttr studentBodyMnemonicSeparatorTag HXT.xpText0
) (
getVerbosity defaultOptions `HXT.xpDefault` HXT.xpickle
) where
defaultOptions = Data.Default.def