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