module BishBosh.Input.UIOptions(
EitherNativeUIOrCECPOptions,
UIOptions(
getMoveNotation,
getMaybePrintMoveTree,
getNDecimalDigits,
getEitherNativeUIOrCECPOptions,
getVerbosity
),
tag,
printMoveTreeTag,
nDecimalDigitsTag,
mkUIOptions,
updateCECPFeature,
deleteCECPFeature,
isCECPManualMode
) where
import BishBosh.Data.Integral()
import Control.Arrow((&&&))
import qualified BishBosh.Data.Either as Data.Either
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Input.CECPFeatures as Input.CECPFeatures
import qualified BishBosh.Input.CECPOptions as Input.CECPOptions
import qualified BishBosh.Input.NativeUIOptions as Input.NativeUIOptions
import qualified BishBosh.Input.Verbosity as Input.Verbosity
import qualified BishBosh.Notation.MoveNotation as Notation.MoveNotation
import qualified BishBosh.Property.ShowFloat as Property.ShowFloat
import qualified BishBosh.Property.Tree as Property.Tree
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 Distribution.Verbosity
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag = "uiOptions"
printMoveTreeTag :: String
printMoveTreeTag = "printMoveTree"
nDecimalDigitsTag :: String
nDecimalDigitsTag = "nDecimalDigits"
maxNDecimalDigits :: Property.ShowFloat.NDecimalDigits
maxNDecimalDigits = floor $ fromIntegral (
floatDigits (
undefined :: Double
)
) * (logBase 10 2 :: Double)
type EitherNativeUIOrCECPOptions row column = Either (Input.NativeUIOptions.NativeUIOptions row column) Input.CECPOptions.CECPOptions
data UIOptions row column = MkUIOptions {
getMoveNotation :: Notation.MoveNotation.MoveNotation,
getMaybePrintMoveTree :: Maybe Property.Tree.Depth,
getNDecimalDigits :: Property.ShowFloat.NDecimalDigits,
getEitherNativeUIOrCECPOptions :: EitherNativeUIOrCECPOptions row column,
getVerbosity :: Distribution.Verbosity.Verbosity
} deriving Eq
instance (
Control.DeepSeq.NFData column,
Control.DeepSeq.NFData row
) => Control.DeepSeq.NFData (UIOptions row column) where
rnf MkUIOptions {
getMoveNotation = moveNotation,
getMaybePrintMoveTree = maybePrintMoveTree,
getNDecimalDigits = nDecimalDigits,
getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions,
getVerbosity = verbosity
} = Control.DeepSeq.rnf (
moveNotation,
maybePrintMoveTree,
nDecimalDigits,
eitherNativeUIOrCECPOptions,
verbosity
)
instance (Show row, Show column) => Show (UIOptions row column) where
showsPrec _ MkUIOptions {
getMoveNotation = moveNotation,
getMaybePrintMoveTree = maybePrintMoveTree,
getNDecimalDigits = nDecimalDigits,
getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions,
getVerbosity = verbosity
} = Text.ShowList.showsAssociationList' $ Data.Maybe.maybe id (
(:) . (,) printMoveTreeTag . shows
) maybePrintMoveTree [
(
Notation.MoveNotation.tag,
shows moveNotation
), (
nDecimalDigitsTag,
shows nDecimalDigits
),
either (
(,) Input.NativeUIOptions.tag . shows
) (
(,) Input.CECPOptions.tag . shows
) eitherNativeUIOrCECPOptions, (
Input.Verbosity.tag,
shows verbosity
)
]
instance (Num row, Num column) => Data.Default.Default (UIOptions row column) where
def = MkUIOptions {
getMoveNotation = Data.Default.def,
getMaybePrintMoveTree = Nothing,
getNDecimalDigits = 3,
getEitherNativeUIOrCECPOptions = Left Data.Default.def,
getVerbosity = Data.Default.def
}
instance (
HXT.XmlPickler column,
HXT.XmlPickler row,
Integral column,
Integral row,
Show column,
Show row
) => HXT.XmlPickler (UIOptions row column) where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpElem tag . HXT.xpWrap (
\(a, b, c, d, e) -> mkUIOptions a b c d e,
\MkUIOptions {
getMoveNotation = moveNotation,
getMaybePrintMoveTree = maybePrintMoveTree,
getNDecimalDigits = nDecimalDigits,
getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions,
getVerbosity = verbosity
} -> (
moveNotation,
maybePrintMoveTree,
nDecimalDigits,
eitherNativeUIOrCECPOptions,
verbosity
)
) $ HXT.xp5Tuple HXT.xpickle (
HXT.xpOption $ HXT.xpAttr printMoveTreeTag HXT.xpickle
) (
getNDecimalDigits def `HXT.xpDefault` HXT.xpAttr nDecimalDigitsTag HXT.xpickle
) (
getEitherNativeUIOrCECPOptions def `HXT.xpDefault` Data.Either.xpickle HXT.xpickle HXT.xpickle
) (
getVerbosity def `HXT.xpDefault` HXT.xpickle
) where
def = Data.Default.def
mkUIOptions
:: Notation.MoveNotation.MoveNotation
-> Maybe Property.Tree.Depth
-> Property.ShowFloat.NDecimalDigits
-> EitherNativeUIOrCECPOptions row column
-> Distribution.Verbosity.Verbosity
-> UIOptions row column
mkUIOptions moveNotation maybePrintMoveTree nDecimalDigits eitherNativeUIOrCECPOptions verbosity
| Just depth <- maybePrintMoveTree
, depth <= 0 = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.UIOptions.mkUIOptions:\t" . showString printMoveTreeTag . Text.ShowList.showsAssociation $ shows depth " must exceed zero."
| nDecimalDigits < 1 = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.UIOptions.mkUIOptions:\t" . showString nDecimalDigitsTag . Text.ShowList.showsAssociation $ shows nDecimalDigits " must exceed zero."
| nDecimalDigits > maxNDecimalDigits = Control.Exception.throw . Data.Exception.mkOutOfBounds . showString "BishBosh.Input.UIOptions.mkUIOptions:\t" . showString nDecimalDigitsTag . Text.ShowList.showsAssociation . shows nDecimalDigits . showString " shouldn't exceed " $ shows maxNDecimalDigits "."
| (
const False `either` const True
) eitherNativeUIOrCECPOptions && not (
Notation.MoveNotation.isCoordinate moveNotation
) = Control.Exception.throw . Data.Exception.mkIncompatibleData . showString "BishBosh.Input.UIOptions.mkUIOptions:\t" . shows Input.CECPOptions.tag . showString " is incompatible with " . showString Notation.MoveNotation.tag . Text.ShowList.showsAssociation $ shows moveNotation "."
| otherwise = MkUIOptions {
getMoveNotation = moveNotation,
getMaybePrintMoveTree = maybePrintMoveTree,
getNDecimalDigits = nDecimalDigits,
getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions,
getVerbosity = verbosity
}
isCECPManualMode :: UIOptions row column -> Bool
isCECPManualMode MkUIOptions { getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions } = (
const False `either` (
uncurry (||) . (Input.CECPOptions.getEditMode &&& Input.CECPOptions.getForceMode)
)
) eitherNativeUIOrCECPOptions
type Transformation row column = UIOptions row column -> UIOptions row column
updateCECPFeature :: Input.CECPFeatures.Feature -> Transformation row column
updateCECPFeature feature uiOptions@MkUIOptions { getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions } = uiOptions {
getEitherNativeUIOrCECPOptions = Input.CECPOptions.updateFeature feature `fmap` eitherNativeUIOrCECPOptions
}
deleteCECPFeature :: Input.CECPFeatures.Feature -> Transformation row column
deleteCECPFeature feature uiOptions@MkUIOptions { getEitherNativeUIOrCECPOptions = eitherNativeUIOrCECPOptions } = uiOptions {
getEitherNativeUIOrCECPOptions = Input.CECPOptions.deleteFeature feature `fmap` eitherNativeUIOrCECPOptions
}