module BishBosh.Input.CECPOptions(
CECPOptions(
getAnalyseMode,
getDisplaySAN,
getEditMode,
getForceMode,
getMaybePaused,
getPonderMode,
getPostMode,
getProtocolVersion,
getCECPFeatures
),
tag,
analyseModeTag,
displaySANTag,
editModeTag,
forceModeTag,
ponderModeTag,
postModeTag,
protocolVersionTag,
getNamedModes,
mkCECPOptions,
setProtocolVersion,
updateFeature,
deleteFeature,
resetModes
) where
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Input.CECPFeatures as Input.CECPFeatures
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Default
import qualified Data.Maybe
import qualified Data.Time.Clock
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag = "cecpOptions"
analyseModeTag :: String
analyseModeTag = "analyseMode"
displaySANTag :: String
displaySANTag = "displaySAN"
editModeTag :: String
editModeTag = "editMode"
forceModeTag :: String
forceModeTag = "forceMode"
pausedTag :: String
pausedTag = "pause"
ponderModeTag :: String
ponderModeTag = "ponderMode"
postModeTag :: String
postModeTag = "postMode"
protocolVersionTag :: String
protocolVersionTag = "protocolVersion"
type Mode = Bool
type ProtocolVersion = Int
data CECPOptions = MkCECPOptions {
getAnalyseMode :: Mode,
getDisplaySAN :: Bool,
getEditMode :: Mode,
getForceMode :: Mode,
getMaybePaused :: Maybe Data.Time.Clock.NominalDiffTime,
getPonderMode :: Mode,
getPostMode :: Mode,
getProtocolVersion :: ProtocolVersion,
getCECPFeatures :: Input.CECPFeatures.CECPFeatures
} deriving Eq
instance Control.DeepSeq.NFData CECPOptions where
rnf MkCECPOptions {
getAnalyseMode = analyseMode,
getDisplaySAN = displaySAN,
getEditMode = editMode,
getForceMode = forceMode,
getMaybePaused = maybePaused,
getPonderMode = ponderMode,
getPostMode = postMode,
getProtocolVersion = protocolVersion,
getCECPFeatures = cecpFeatures
} = Control.DeepSeq.rnf (analyseMode, displaySAN, editMode, forceMode, maybePaused, ponderMode, postMode, protocolVersion, cecpFeatures)
instance Show CECPOptions where
showsPrec _ MkCECPOptions {
getAnalyseMode = analyseMode,
getDisplaySAN = displaySAN,
getEditMode = editMode,
getForceMode = forceMode,
getMaybePaused = maybePaused,
getPonderMode = ponderMode,
getPostMode = postMode,
getProtocolVersion = protocolVersion,
getCECPFeatures = cecpFeatures
} = Text.ShowList.showsAssociationList' [
(
analyseModeTag,
shows analyseMode
), (
displaySANTag,
shows displaySAN
), (
editModeTag,
shows editMode
), (
forceModeTag,
shows forceMode
), (
pausedTag,
shows maybePaused
), (
ponderModeTag,
shows ponderMode
), (
postModeTag,
shows postMode
), (
protocolVersionTag,
shows protocolVersion
), (
Input.CECPFeatures.tag,
showChar '{' . shows cecpFeatures . showChar '}'
)
]
instance Data.Default.Default CECPOptions where
def = MkCECPOptions {
getAnalyseMode = False,
getEditMode = False,
getDisplaySAN = True,
getForceMode = False,
getMaybePaused = Nothing,
getPonderMode = False,
getPostMode = False,
getProtocolVersion = 1,
getCECPFeatures = Data.Default.def
}
instance HXT.XmlPickler CECPOptions where
xpickle = HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d, e, f, g, h, i) -> mkCECPOptions a b c d e f g h i,
\MkCECPOptions {
getAnalyseMode = analyseMode,
getDisplaySAN = displaySAN,
getEditMode = editMode,
getForceMode = forceMode,
getMaybePaused = maybePaused,
getPonderMode = ponderMode,
getPostMode = postMode,
getProtocolVersion = protocolVersion,
getCECPFeatures = cecpFeatures
} -> (analyseMode, displaySAN, editMode, forceMode, maybePaused, ponderMode, postMode, protocolVersion, cecpFeatures)
) $ HXT.xp9Tuple (
getAnalyseMode def `HXT.xpDefault` HXT.xpAttr analyseModeTag HXT.xpickle
) (
getDisplaySAN def `HXT.xpDefault` HXT.xpAttr displaySANTag HXT.xpickle
) (
getEditMode def `HXT.xpDefault` HXT.xpAttr editModeTag HXT.xpickle
) (
getForceMode def `HXT.xpDefault` HXT.xpAttr forceModeTag HXT.xpickle
) (
HXT.xpOption . HXT.xpWrap (toEnum, fromEnum) $ HXT.xpAttr pausedTag HXT.xpInt
) (
getPonderMode def `HXT.xpDefault` HXT.xpAttr ponderModeTag HXT.xpickle
) (
getPostMode def `HXT.xpDefault` HXT.xpAttr postModeTag HXT.xpickle
) (
getProtocolVersion def `HXT.xpDefault` HXT.xpAttr protocolVersionTag HXT.xpickle
) HXT.xpickle where
def = Data.Default.def
mkCECPOptions
:: Mode
-> Bool
-> Mode
-> Mode
-> Maybe Data.Time.Clock.NominalDiffTime
-> Mode
-> Mode
-> ProtocolVersion
-> Input.CECPFeatures.CECPFeatures
-> CECPOptions
mkCECPOptions analyseMode displaySAN editMode forceMode maybePaused ponderMode postMode protocolVersion cecpFeatures
| protocolVersion < 1 = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.UI.CECPOptions.mkCECPOptions:\t" $ shows protocolVersionTag " must exceed zero."
| Data.Maybe.maybe False (< 0) maybePaused = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.UI.CECPOptions.mkCECPOptions:\t" $ shows pausedTag "; time already taken can't be negative."
| otherwise = MkCECPOptions {
getAnalyseMode = analyseMode,
getEditMode = editMode,
getDisplaySAN = displaySAN,
getForceMode = forceMode,
getMaybePaused = maybePaused,
getPonderMode = ponderMode,
getPostMode = postMode,
getProtocolVersion = protocolVersion,
getCECPFeatures = cecpFeatures
}
type Transformation = CECPOptions -> CECPOptions
setProtocolVersion :: ProtocolVersion -> Transformation
setProtocolVersion protocolVersion cecpOptions
| protocolVersion < 1 = Control.Exception.throw $ Data.Exception.mkOutOfBounds . showString "BishBosh.UI.CECPOptions.setProtocolVersion:\t" $ shows protocolVersion " must exceed zero."
| otherwise = cecpOptions {
getProtocolVersion = protocolVersion
}
updateFeature :: Input.CECPFeatures.Feature -> Transformation
updateFeature feature cecpOptions@MkCECPOptions { getCECPFeatures = cecpFeatures } = cecpOptions {
getCECPFeatures = Input.CECPFeatures.updateFeature feature cecpFeatures
}
deleteFeature :: Input.CECPFeatures.Feature -> Transformation
deleteFeature feature cecpOptions@MkCECPOptions { getCECPFeatures = cecpFeatures } = cecpOptions {
getCECPFeatures = Input.CECPFeatures.deleteFeature feature cecpFeatures
}
resetModes :: Transformation
resetModes cecpOptions = cecpOptions {
getAnalyseMode = False,
getEditMode = False,
getForceMode = False,
getMaybePaused = Nothing,
getPonderMode = False,
getPostMode = False
}
getNamedModes :: CECPOptions -> [(String, Mode)]
getNamedModes MkCECPOptions {
getAnalyseMode = analyseMode,
getEditMode = editMode,
getForceMode = forceMode,
getMaybePaused = maybePaused,
getPonderMode = ponderMode,
getPostMode = postMode
} = [
(
analyseModeTag,
analyseMode
), (
editModeTag,
editMode
), (
forceModeTag,
forceMode
), (
pausedTag,
Data.Maybe.isJust maybePaused
), (
ponderModeTag,
ponderMode
), (
postModeTag,
postMode
)
]