module BishBosh.Input.CECPFeatures(
Feature,
CECPFeatures(
getFeatures
),
tag,
featureTag,
analyseTag,
coloursTag,
drawTag,
icsTag,
nameTag,
npsTag,
optionTag,
pauseTag,
pingTag,
playotherTag,
setboardTag,
timeTag,
usermoveTag,
resolution,
inputWidget,
sliderWidget,
mkCECPFeatures,
prependFeature,
deleteFeature,
updateFeature,
isFeatureDisabled
) where
import BishBosh.Data.Bool()
import Control.Arrow((|||))
import qualified BishBosh.Data.Exception as Data.Exception
import qualified BishBosh.Data.Foldable as Data.Foldable
import qualified BishBosh.Text.ShowList as Text.ShowList
import qualified Control.DeepSeq
import qualified Control.Exception
import qualified Data.Char
import qualified Data.Default
import qualified Data.List
import qualified Data.Maybe
import qualified Text.XML.HXT.Arrow.Pickle as HXT
tag :: String
tag :: String
tag = String
"cecpFeatures"
featureTag :: String
featureTag :: String
featureTag = String
"feature"
type Key = String
type Value = Either Int String
type Feature = (Key, Value)
analyseTag :: Key
analyseTag :: String
analyseTag = String
"analyze"
coloursTag :: Key
coloursTag :: String
coloursTag = String
"colors"
debugTag :: Key
debugTag :: String
debugTag = String
"debug"
doneTag :: Key
doneTag :: String
doneTag = String
"done"
drawTag :: Key
drawTag :: String
drawTag = String
"draw"
egtTag :: Key
egtTag :: String
egtTag = String
"egt"
excludeTag :: Key
excludeTag :: String
excludeTag = String
"exclude"
highlightTag :: Key
highlightTag :: String
highlightTag = String
"highlight"
icsTag :: Key
icsTag :: String
icsTag = String
"ics"
memoryTag :: Key
memoryTag :: String
memoryTag = String
"memory"
mynameTag :: Key
mynameTag :: String
mynameTag = String
"myname"
nameTag :: Key
nameTag :: String
nameTag = String
"name"
npsTag :: Key
npsTag :: String
npsTag = String
"nps"
optionTag :: Key
optionTag :: String
optionTag = String
"option"
pauseTag :: Key
pauseTag :: String
pauseTag = String
"pause"
pingTag :: Key
pingTag :: String
pingTag = String
"ping"
playotherTag :: Key
playotherTag :: String
playotherTag = String
"playother"
reuseTag :: Key
reuseTag :: String
reuseTag = String
"reuse"
sanTag :: Key
sanTag :: String
sanTag = String
"san"
setboardTag :: Key
setboardTag :: String
setboardTag = String
"setboard"
sigintTag :: Key
sigintTag :: String
sigintTag = String
"sigint"
sigtermTag :: Key
sigtermTag :: String
sigtermTag = String
"sigterm"
smpTag :: Key
smpTag :: String
smpTag = String
"smp"
timeTag :: Key
timeTag :: String
timeTag = String
"time"
usermoveTag :: Key
usermoveTag :: String
usermoveTag = String
"usermove"
variantsTag :: Key
variantsTag :: String
variantsTag = String
"variants"
showsFeatureSeparator :: ShowS
showsFeatureSeparator :: ShowS
showsFeatureSeparator = Char -> ShowS
showChar Char
' '
showsKVSeparator :: ShowS
showsKVSeparator :: ShowS
showsKVSeparator = Char -> ShowS
showChar Char
'='
resolution :: Int
resolution :: Int
resolution = Int
1000
inputWidget :: String
inputWidget :: String
inputWidget = String
"-string"
sliderWidget :: String
sliderWidget :: String
sliderWidget = String
"-slider"
data CECPFeatures = MkCECPFeatures {
CECPFeatures -> [Feature]
getFeatures :: [Feature],
CECPFeatures -> Bool
getDone :: Bool
} deriving CECPFeatures -> CECPFeatures -> Bool
(CECPFeatures -> CECPFeatures -> Bool)
-> (CECPFeatures -> CECPFeatures -> Bool) -> Eq CECPFeatures
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CECPFeatures -> CECPFeatures -> Bool
$c/= :: CECPFeatures -> CECPFeatures -> Bool
== :: CECPFeatures -> CECPFeatures -> Bool
$c== :: CECPFeatures -> CECPFeatures -> Bool
Eq
instance Control.DeepSeq.NFData CECPFeatures where
rnf :: CECPFeatures -> ()
rnf MkCECPFeatures {
getFeatures :: CECPFeatures -> [Feature]
getFeatures = [Feature]
features,
getDone :: CECPFeatures -> Bool
getDone = Bool
done
} = ([Feature], Bool) -> ()
forall a. NFData a => a -> ()
Control.DeepSeq.rnf ([Feature]
features, Bool
done)
instance Show CECPFeatures where
showsPrec :: Int -> CECPFeatures -> ShowS
showsPrec Int
_ MkCECPFeatures {
getFeatures :: CECPFeatures -> [Feature]
getFeatures = [Feature]
features,
getDone :: CECPFeatures -> Bool
getDone = Bool
done
} = ShowS -> ShowS -> ShowS -> [ShowS] -> ShowS
Text.ShowList.showsDelimitedList ShowS
showsFeatureSeparator ShowS
forall a. a -> a
id ShowS
forall a. a -> a
id (
(Feature -> ShowS) -> [Feature] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (
\(String
k, Either Int String
v) -> String -> ShowS
showString String
k ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsKVSeparator ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ShowS) -> (String -> ShowS) -> Either Int String -> ShowS
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Int -> ShowS
forall a. Show a => a -> ShowS
shows (\String
s -> Char -> ShowS
showChar Char
'"' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'"') Either Int String
v
) [Feature]
features
) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsFeatureSeparator ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
doneTag ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showsKVSeparator ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows (if Bool
done then (Int
1 :: Int) else Int
0)
instance Data.Default.Default CECPFeatures where
def :: CECPFeatures
def = MkCECPFeatures :: [Feature] -> Bool -> CECPFeatures
MkCECPFeatures {
getFeatures :: [Feature]
getFeatures = let
Either Int b
false : Either Int b
true : [Either Int b]
_ = (Int -> Either Int b) -> [Int] -> [Either Int b]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Either Int b
forall a b. a -> Either a b
Left [Int
0 ..]
mkCommaSeparatedList :: [String] -> Either a String
mkCommaSeparatedList = String -> Either a String
forall a b. b -> Either a b
Right (String -> Either a String)
-> ([String] -> String) -> [String] -> Either a String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
Data.List.intercalate String
","
in [
(
String
analyseTag, Either Int String
forall b. Either Int b
false
), (
String
coloursTag, Either Int String
forall b. Either Int b
false
), (
String
drawTag, Either Int String
forall b. Either Int b
true
), (
String
debugTag, Either Int String
forall b. Either Int b
false
), (
String
egtTag, [String] -> Either Int String
forall a. [String] -> Either a String
mkCommaSeparatedList []
), (
String
excludeTag, Either Int String
forall b. Either Int b
false
), (
String
highlightTag, Either Int String
forall b. Either Int b
false
), (
String
icsTag, Either Int String
forall b. Either Int b
true
), (
String
memoryTag, Either Int String
forall b. Either Int b
false
), (
String
mynameTag, String -> Either Int String
forall a b. b -> Either a b
Right String
"BishBosh"
), (
String
nameTag, Either Int String
forall b. Either Int b
true
), (
String
npsTag, Either Int String
forall b. Either Int b
false
), (
String
pauseTag, Either Int String
forall b. Either Int b
true
), (
String
pingTag, Either Int String
forall b. Either Int b
true
), (
String
playotherTag, Either Int String
forall b. Either Int b
true
), (
String
reuseTag, Either Int String
forall b. Either Int b
true
), (
String
sanTag, Either Int String
forall b. Either Int b
false
), (
String
setboardTag, Either Int String
forall b. Either Int b
true
), (
String
sigintTag, Either Int String
forall b. Either Int b
false
), (
String
sigtermTag, Either Int String
forall b. Either Int b
true
), (
String
smpTag, Either Int String
forall b. Either Int b
true
), (
String
timeTag, Either Int String
forall b. Either Int b
false
), (
String
usermoveTag, Either Int String
forall b. Either Int b
true
), (
String
variantsTag, [String] -> Either Int String
forall a. [String] -> Either a String
mkCommaSeparatedList [
String
"normal"
]
)
],
getDone :: Bool
getDone = Bool
True
}
instance HXT.XmlPickler CECPFeatures where
xpickle :: PU CECPFeatures
xpickle = CECPFeatures -> PU CECPFeatures -> PU CECPFeatures
forall a. Eq a => a -> PU a -> PU a
HXT.xpDefault CECPFeatures
def (PU CECPFeatures -> PU CECPFeatures)
-> (PU ([Feature], Bool) -> PU CECPFeatures)
-> PU ([Feature], Bool)
-> PU CECPFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU CECPFeatures -> PU CECPFeatures
forall a. String -> PU a -> PU a
HXT.xpElem String
tag (PU CECPFeatures -> PU CECPFeatures)
-> (PU ([Feature], Bool) -> PU CECPFeatures)
-> PU ([Feature], Bool)
-> PU CECPFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Feature], Bool) -> CECPFeatures,
CECPFeatures -> ([Feature], Bool))
-> PU ([Feature], Bool) -> PU CECPFeatures
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
([Feature] -> Bool -> CECPFeatures)
-> ([Feature], Bool) -> CECPFeatures
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Feature] -> Bool -> CECPFeatures
mkCECPFeatures,
\MkCECPFeatures {
getFeatures :: CECPFeatures -> [Feature]
getFeatures = [Feature]
features,
getDone :: CECPFeatures -> Bool
getDone = Bool
done
} -> ([Feature]
features, Bool
done)
) (PU ([Feature], Bool) -> PU CECPFeatures)
-> PU ([Feature], Bool) -> PU CECPFeatures
forall a b. (a -> b) -> a -> b
$ (
PU Feature -> PU [Feature]
forall a. PU a -> PU [a]
HXT.xpList (PU Feature -> PU [Feature])
-> (PU Feature -> PU Feature) -> PU Feature -> PU [Feature]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PU Feature -> PU Feature
forall a. String -> PU a -> PU a
HXT.xpElem String
featureTag (PU Feature -> PU [Feature]) -> PU Feature -> PU [Feature]
forall a b. (a -> b) -> a -> b
$ String -> PU String
HXT.xpTextAttr String
"key" PU String -> PU (Either Int String) -> PU Feature
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` (String -> Either Int String, Either Int String -> String)
-> PU String -> PU (Either Int String)
forall a b. (a -> b, b -> a) -> PU a -> PU b
HXT.xpWrap (
\String
s -> case ReadS Int
forall a. Read a => ReadS a
reads String
s of
[(Int
i, String
"")] -> Int -> Either Int String
forall a b. a -> Either a b
Left Int
i
[(Int, String)]
_ -> String -> Either Int String
forall a b. b -> Either a b
Right String
s,
\Either Int String
value -> Char -> ShowS
showChar Char
'"' ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Int -> ShowS
forall a. Show a => a -> ShowS
shows (Int -> ShowS) -> (String -> ShowS) -> Either Int String -> ShowS
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| String -> ShowS
showString) Either Int String
value String
"\""
) (
String -> PU String -> PU String
forall a. String -> PU a -> PU a
HXT.xpAttr String
"value" PU String
HXT.xpText0
)
) PU [Feature] -> PU Bool -> PU ([Feature], Bool)
forall a b. PU a -> PU b -> PU (a, b)
`HXT.xpPair` (
CECPFeatures -> Bool
getDone CECPFeatures
def Bool -> PU Bool -> PU Bool
forall a. Eq a => a -> PU a -> PU a
`HXT.xpDefault` String -> PU Bool -> PU Bool
forall a. String -> PU a -> PU a
HXT.xpAttr String
doneTag PU Bool
forall a. XmlPickler a => PU a
HXT.xpickle
) where
def :: CECPFeatures
def = CECPFeatures
forall a. Default a => a
Data.Default.def
mkCECPFeatures :: [Feature] -> Bool -> CECPFeatures
mkCECPFeatures :: [Feature] -> Bool -> CECPFeatures
mkCECPFeatures [Feature]
features Bool
done
| Just (String
key, Either Int String
_) <- (Feature -> Bool) -> [Feature] -> Maybe Feature
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
Bool -> Bool
not (Bool -> Bool) -> (Feature -> Bool) -> Feature -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Data.Char.isAlpha (String -> Bool) -> (Feature -> String) -> Feature -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> String
forall a b. (a, b) -> a
fst
) [Feature]
features = Exception -> CECPFeatures
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CECPFeatures)
-> (String -> Exception) -> String -> CECPFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.CECPFeatures.mkCECPFeatures:\tinvalid key" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> CECPFeatures) -> String -> CECPFeatures
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
key String
"."
| Just (String
_, Either Int String
value) <- (Feature -> Bool) -> [Feature] -> Maybe Feature
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find (
(
Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
False (Int -> Bool) -> (String -> Bool) -> Either Int String -> Bool
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\"\n\r")
) (Either Int String -> Bool)
-> (Feature -> Either Int String) -> Feature -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> Either Int String
forall a b. (a, b) -> b
snd
) [Feature]
features = Exception -> CECPFeatures
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CECPFeatures)
-> (String -> Exception) -> String -> CECPFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkInvalidDatum (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.CECPFeatures.mkCECPFeatures:\tinvalid value" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
Text.ShowList.showsAssociation (String -> CECPFeatures) -> String -> CECPFeatures
forall a b. (a -> b) -> a -> b
$ Either Int String -> ShowS
forall a. Show a => a -> ShowS
shows Either Int String
value String
"."
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
duplicateFeatures = Exception -> CECPFeatures
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> CECPFeatures)
-> (String -> Exception) -> String -> CECPFeatures
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkDuplicateData (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.CECPFeatures.mkCECPFeatures:\tduplicate features " (String -> CECPFeatures) -> String -> CECPFeatures
forall a b. (a -> b) -> a -> b
$ [String] -> ShowS
forall a. Show a => a -> ShowS
shows [String]
duplicateFeatures String
"."
| Bool
otherwise = MkCECPFeatures :: [Feature] -> Bool -> CECPFeatures
MkCECPFeatures {
getFeatures :: [Feature]
getFeatures = [Feature]
features,
getDone :: Bool
getDone = Bool
done
}
where
duplicateFeatures :: [String]
duplicateFeatures = [String] -> [String]
forall (foldable :: * -> *) a.
(Foldable foldable, Ord a) =>
foldable a -> [a]
Data.Foldable.findDuplicates ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Feature -> String) -> [Feature] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Feature -> String
forall a b. (a, b) -> a
fst [Feature]
features
type Transformation = CECPFeatures -> CECPFeatures
prependFeature :: Feature -> Transformation
prependFeature :: Feature -> Transformation
prependFeature Feature
feature cecpFeatures :: CECPFeatures
cecpFeatures@MkCECPFeatures {
getFeatures :: CECPFeatures -> [Feature]
getFeatures = [Feature]
features
} = CECPFeatures
cecpFeatures {
getFeatures :: [Feature]
getFeatures = Feature
feature Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: [Feature]
features
}
deleteFeature :: Feature -> Transformation
deleteFeature :: Feature -> Transformation
deleteFeature feature :: Feature
feature@(String
key, Either Int String
value) cecpFeatures :: CECPFeatures
cecpFeatures@MkCECPFeatures {
getFeatures :: CECPFeatures -> [Feature]
getFeatures = [Feature]
features
} = CECPFeatures
cecpFeatures {
getFeatures :: [Feature]
getFeatures = (Feature -> Bool) -> [Feature] -> [Feature]
forall a. (a -> Bool) -> [a] -> [a]
filter (
(Feature -> Bool) -> Int -> Feature -> Bool
forall a b. a -> b -> a
const (
(String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
key) (String -> Bool) -> (Feature -> String) -> Feature -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> String
forall a b. (a, b) -> a
fst
) (Int -> Feature -> Bool)
-> (String -> Feature -> Bool)
-> Either Int String
-> Feature
-> Bool
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| (Feature -> Bool) -> String -> Feature -> Bool
forall a b. a -> b -> a
const (Feature -> Feature -> Bool
forall a. Eq a => a -> a -> Bool
/= Feature
feature) (Either Int String -> Feature -> Bool)
-> Either Int String -> Feature -> Bool
forall a b. (a -> b) -> a -> b
$ Either Int String
value
) [Feature]
features
}
updateFeature :: Feature -> Transformation
updateFeature :: Feature -> Transformation
updateFeature Feature
feature = Feature -> Transformation
prependFeature Feature
feature Transformation -> Transformation -> Transformation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Feature -> Transformation
deleteFeature Feature
feature
isFeatureDisabled :: Key -> CECPFeatures -> Bool
isFeatureDisabled :: String -> CECPFeatures -> Bool
isFeatureDisabled String
key MkCECPFeatures {
getFeatures :: CECPFeatures -> [Feature]
getFeatures = [Feature]
features
} = Bool
-> (Either Int String -> Bool) -> Maybe (Either Int String) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
Data.Maybe.maybe (
Exception -> Bool
forall a e. Exception e => e -> a
Control.Exception.throw (Exception -> Bool) -> (String -> Exception) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Exception
Data.Exception.mkSearchFailure (String -> Exception) -> ShowS -> String -> Exception
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"BishBosh.Input.CECPFeatures.isFeatureDisabled:\t" (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String -> ShowS
forall a. Show a => a -> ShowS
shows String
key String
" not found."
) (
(Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (String -> Bool) -> Either Int String -> Bool
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
) (Maybe (Either Int String) -> Bool)
-> Maybe (Either Int String) -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [Feature] -> Maybe (Either Int String)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key [Feature]
features