{-# LANGUAGE CPP, FlexibleContexts #-} {- Copyright (C) 2013-2015 Dr. Alistair Ward This file is part of WeekDaze. WeekDaze is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. WeekDaze is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with WeekDaze. If not, see . -} {- | [@AUTHOR@] Dr. Alistair Ward [@DESCRIPTION@] Defines options related to program-output. -} module WeekDaze.OutputConfiguration.Options( -- * Types -- ** Type-synonyms NDecimalDigits, -- ** Data-types Options( -- MkOptions, getFileFormats, getMaybeOutputConfigFilePath, getNDecimalDigits, getStudentBodyMnemonicSeparator, getVerbosity ), -- * Constants -- tag, -- fileFormatsTag, nDecimalDigitsTag, outputConfigFilePathTag, -- studentBodyMnemonicSeparatorTag, -- * Functions -- ** Constructor 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 {-to IO-monad-} options' { getFileFormats = [OutputConfiguration.FileFormat.mkFileFormat OutputConfiguration.FileFormat.stdoutProxy {-CAVEAT: hard-coded-} $ OutputConfiguration.Format.XHTML style] } #else import WeekDaze.OutputConfiguration.Verbosity() #endif /* USE_HDBC */ -- | Used to qualify XML. tag :: String tag = "outputOptions" -- | Used to qualify XML. fileFormatsTag :: String fileFormatsTag = "fileFormats" -- | Used to qualify SQL & XML. nDecimalDigitsTag :: String nDecimalDigitsTag = "nDecimalDigits" -- | Used to qualify XML. outputConfigFilePathTag :: String outputConfigFilePathTag = "outputConfigFilePath" -- | Used to qualify SQL & XML. studentBodyMnemonicSeparatorTag :: String studentBodyMnemonicSeparatorTag = "studentBodyMnemonicSeparator" -- | A number of decimals digits. type NDecimalDigits = Int -- | Defines the set of output-options. data Options minimumContrastRatio = MkOptions { getFileFormats :: [OutputConfiguration.FileFormat.FileFormat minimumContrastRatio], -- ^ Defines the formats of the required output-files. getMaybeOutputConfigFilePath :: Maybe System.FilePath.FilePath, -- ^ Optional path to a file, into which the unprocessed configuration, formatted as XML, should be written (obliterating any existing file-contents). getNDecimalDigits :: NDecimalDigits, -- ^ The precision to which fractional auxiliary data is displayed. getStudentBodyMnemonicSeparator :: Aggregate.StudentClass.MnemonicSeparator, -- ^ The separator used when merging the mnemonics of /student-bodies/. getVerbosity :: Distribution.Verbosity.Verbosity -- ^ Set the threshold for ancillary information-output. } 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 :: [[OutputConfiguration.FileFormat.FileFormat minimumContrastRatio]] 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 {-i.e. non-null on POSIX-}) 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 -- CAVEAT: the actual type could be merely 'Float', but that's currently unknown. ) ) * (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) -- | Smart constructor. mkOptions :: Show minimumContrastRatio => [OutputConfiguration.FileFormat.FileFormat minimumContrastRatio] -- ^ The formats in which to file the results. -> Maybe System.FilePath.FilePath -- ^ An optional path to a file, into which the unprocessed configuration, formatted as XML, should be written. -> NDecimalDigits -- ^ The number of decimal digits with which to log the value of /lesson-criteria/ & /timetable-criteria/. -> Aggregate.StudentClass.MnemonicSeparator -- ^ The separator to use when /student-bodies/ with identical profiles have been merged automatically during runtime. -> Distribution.Verbosity.Verbosity -- ^ The amount of auxiliary data to log. -> 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, -- Construct from a tuple. \MkOptions { getFileFormats = fileFormats, getMaybeOutputConfigFilePath = maybeOutputConfigFilePath, getNDecimalDigits = nDecimalDigits, getStudentBodyMnemonicSeparator = studentBodyMnemonicSeparator, getVerbosity = verbosity } -> (fileFormats, maybeOutputConfigFilePath, nDecimalDigits, studentBodyMnemonicSeparator, verbosity) -- Deconstruct into a tuple. ) $ HXT.xp5Tuple ( HXT.xpDefault (getFileFormats defaultOptions) . HXT.xpElem fileFormatsTag $ HXT.xpList1 {-can't be null-} HXT.xpickle {-FileFormat-} ) ( HXT.xpOption $ HXT.xpTextAttr outputConfigFilePathTag {-can't be null-} ) ( getNDecimalDigits defaultOptions `HXT.xpDefault` HXT.xpAttr nDecimalDigitsTag HXT.xpInt ) ( getStudentBodyMnemonicSeparator defaultOptions `HXT.xpDefault` HXT.xpAttr studentBodyMnemonicSeparatorTag HXT.xpText0 {-can be null-} ) ( getVerbosity defaultOptions `HXT.xpDefault` HXT.xpickle ) where defaultOptions = Data.Default.def