{-# LANGUAGE CPP, TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}
module Game.Goatee.Lib.Property.Base (
Property (..),
PropertyType (..),
Descriptor (..), ValuedDescriptor (..),
AnyDescriptor (..), AnyValuedDescriptor (..), AnyCoordListDescriptor,
PropertyInfo,
ValuedPropertyInfo (ValuedPropertyInfo),
defProperty, defValuedProperty,
) where
import Game.Goatee.Lib.Property.Value (PropertyValueType(..), nonePvt)
import Game.Goatee.Lib.Renderer
import Game.Goatee.Lib.Types
import Language.Haskell.TH (
Info (DataConI), DecsQ, Name, Type (AppT),
appE, appT, caseE, conE, conP, conT, lam1E, match, mkName, newName,
normalB, recP, reify, sigD, stringE, valD, varE, varP, wildP,
)
import Text.ParserCombinators.Parsec (Parser)
data Property =
B (Maybe Coord)
| KO
| MN Integer
| W (Maybe Coord)
| AB CoordList
| AE CoordList
| AW CoordList
| PL Color
| C Text
| DM DoubleValue
| GB DoubleValue
| GW DoubleValue
| HO DoubleValue
| N SimpleText
| UC DoubleValue
| V RealValue
| BM DoubleValue
| DO
| IT
| TE DoubleValue
| AR ArrowList
| CR CoordList
| DD CoordList
| LB LabelList
| LN LineList
| MA CoordList
| SL CoordList
| SQ CoordList
| TR CoordList
| AP SimpleText SimpleText
| CA SimpleText
| FF Int
| GM Int
| ST VariationMode
| SZ Int Int
| AN SimpleText
| BR SimpleText
| BT SimpleText
| CP SimpleText
| DT SimpleText
| EV SimpleText
| GC Text
| GN SimpleText
| ON SimpleText
| OT SimpleText
| PB SimpleText
| PC SimpleText
| PW SimpleText
| RE GameResult
| RO SimpleText
| RU Ruleset
| SO SimpleText
| TM RealValue
| US SimpleText
| WR SimpleText
| WT SimpleText
| BL RealValue
| OB Int
| OW Int
| WL RealValue
| VW CoordList
| HA Int
| KM RealValue
| TB CoordList
| TW CoordList
| UnknownProperty String UnknownPropertyValue
deriving (Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq, Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Property] -> ShowS
$cshowList :: [Property] -> ShowS
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> ShowS
$cshowsPrec :: Int -> Property -> ShowS
Show)
data PropertyType = MoveProperty
| SetupProperty
| RootProperty
| GameInfoProperty
| GeneralProperty
deriving (PropertyType -> PropertyType -> Bool
(PropertyType -> PropertyType -> Bool)
-> (PropertyType -> PropertyType -> Bool) -> Eq PropertyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PropertyType -> PropertyType -> Bool
$c/= :: PropertyType -> PropertyType -> Bool
== :: PropertyType -> PropertyType -> Bool
$c== :: PropertyType -> PropertyType -> Bool
Eq, Int -> PropertyType -> ShowS
[PropertyType] -> ShowS
PropertyType -> String
(Int -> PropertyType -> ShowS)
-> (PropertyType -> String)
-> ([PropertyType] -> ShowS)
-> Show PropertyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyType] -> ShowS
$cshowList :: [PropertyType] -> ShowS
show :: PropertyType -> String
$cshow :: PropertyType -> String
showsPrec :: Int -> PropertyType -> ShowS
$cshowsPrec :: Int -> PropertyType -> ShowS
Show)
class Descriptor a where
propertyName :: a -> String
propertyType :: a -> PropertyType
propertyInherited :: a -> Bool
propertyPredicate :: a -> Property -> Bool
propertyValueParser :: a -> Parser Property
propertyValueRenderer :: a -> Property -> Render ()
propertyValueRendererPretty :: a -> Property -> Render ()
class (Descriptor a, Eq v) => ValuedDescriptor v a | a -> v where
propertyValue :: a -> Property -> v
propertyBuilder :: a -> v -> Property
data AnyDescriptor = forall a. Descriptor a => AnyDescriptor a
instance Descriptor AnyDescriptor where
propertyName :: AnyDescriptor -> String
propertyName (AnyDescriptor a
d) = a -> String
forall a. Descriptor a => a -> String
propertyName a
d
propertyType :: AnyDescriptor -> PropertyType
propertyType (AnyDescriptor a
d) = a -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType a
d
propertyInherited :: AnyDescriptor -> Bool
propertyInherited (AnyDescriptor a
d) = a -> Bool
forall a. Descriptor a => a -> Bool
propertyInherited a
d
propertyPredicate :: AnyDescriptor -> Property -> Bool
propertyPredicate (AnyDescriptor a
d) = a -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate a
d
propertyValueParser :: AnyDescriptor -> Parser Property
propertyValueParser (AnyDescriptor a
d) = a -> Parser Property
forall a. Descriptor a => a -> Parser Property
propertyValueParser a
d
propertyValueRenderer :: AnyDescriptor -> Property -> Render ()
propertyValueRenderer (AnyDescriptor a
d) = a -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRenderer a
d
propertyValueRendererPretty :: AnyDescriptor -> Property -> Render ()
propertyValueRendererPretty (AnyDescriptor a
d) = a -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRendererPretty a
d
data AnyValuedDescriptor v = forall a. ValuedDescriptor v a => AnyValuedDescriptor a
instance Descriptor (AnyValuedDescriptor v) where
propertyName :: AnyValuedDescriptor v -> String
propertyName (AnyValuedDescriptor a
d) = a -> String
forall a. Descriptor a => a -> String
propertyName a
d
propertyType :: AnyValuedDescriptor v -> PropertyType
propertyType (AnyValuedDescriptor a
d) = a -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType a
d
propertyInherited :: AnyValuedDescriptor v -> Bool
propertyInherited (AnyValuedDescriptor a
d) = a -> Bool
forall a. Descriptor a => a -> Bool
propertyInherited a
d
propertyPredicate :: AnyValuedDescriptor v -> Property -> Bool
propertyPredicate (AnyValuedDescriptor a
d) = a -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate a
d
propertyValueParser :: AnyValuedDescriptor v -> Parser Property
propertyValueParser (AnyValuedDescriptor a
d) = a -> Parser Property
forall a. Descriptor a => a -> Parser Property
propertyValueParser a
d
propertyValueRenderer :: AnyValuedDescriptor v -> Property -> Render ()
propertyValueRenderer (AnyValuedDescriptor a
d) = a -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRenderer a
d
propertyValueRendererPretty :: AnyValuedDescriptor v -> Property -> Render ()
propertyValueRendererPretty (AnyValuedDescriptor a
d) = a -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRendererPretty a
d
instance Eq v => ValuedDescriptor v (AnyValuedDescriptor v) where
propertyValue :: AnyValuedDescriptor v -> Property -> v
propertyValue (AnyValuedDescriptor a
d) = a -> Property -> v
forall v a. ValuedDescriptor v a => a -> Property -> v
propertyValue a
d
propertyBuilder :: AnyValuedDescriptor v -> v -> Property
propertyBuilder (AnyValuedDescriptor a
d) = a -> v -> Property
forall v a. ValuedDescriptor v a => a -> v -> Property
propertyBuilder a
d
type AnyCoordListDescriptor = AnyValuedDescriptor CoordList
data PropertyInfo = PropertyInfo
{ PropertyInfo -> String
propertyInfoName :: String
, PropertyInfo -> Property
propertyInfoInstance :: Property
, PropertyInfo -> PropertyType
propertyInfoType :: PropertyType
, PropertyInfo -> Bool
propertyInfoInherited :: Bool
}
instance Descriptor PropertyInfo where
propertyName :: PropertyInfo -> String
propertyName = PropertyInfo -> String
propertyInfoName
propertyType :: PropertyInfo -> PropertyType
propertyType = PropertyInfo -> PropertyType
propertyInfoType
propertyInherited :: PropertyInfo -> Bool
propertyInherited = PropertyInfo -> Bool
propertyInfoInherited
propertyPredicate :: PropertyInfo -> Property -> Bool
propertyPredicate = Property -> Property -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Property -> Property -> Bool)
-> (PropertyInfo -> Property) -> PropertyInfo -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyInfo -> Property
propertyInfoInstance
propertyValueParser :: PropertyInfo -> Parser Property
propertyValueParser PropertyInfo
descriptor = PropertyInfo -> Property
propertyInfoInstance PropertyInfo
descriptor Property -> ParsecT String () Identity () -> Parser Property
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PropertyValueType () -> ParsecT String () Identity ()
forall a. PropertyValueType a -> Parser a
pvtParser PropertyValueType ()
nonePvt
propertyValueRenderer :: PropertyInfo -> Property -> Render ()
propertyValueRenderer PropertyInfo
_ Property
_ = PropertyValueType () -> () -> Render ()
forall a. PropertyValueType a -> a -> Render ()
pvtRenderer PropertyValueType ()
nonePvt ()
propertyValueRendererPretty :: PropertyInfo -> Property -> Render ()
propertyValueRendererPretty PropertyInfo
_ Property
_ = PropertyValueType () -> () -> Render ()
forall a. PropertyValueType a -> a -> Render ()
pvtRendererPretty PropertyValueType ()
nonePvt ()
data ValuedPropertyInfo v = ValuedPropertyInfo
{ ValuedPropertyInfo v -> String
valuedPropertyInfoName :: String
, ValuedPropertyInfo v -> PropertyType
valuedPropertyInfoType :: PropertyType
, ValuedPropertyInfo v -> Bool
valuedPropertyInfoInherited :: Bool
, ValuedPropertyInfo v -> Property -> Bool
valuedPropertyInfoPredicate :: Property -> Bool
, ValuedPropertyInfo v -> PropertyValueType v
valuedPropertyInfoValueType :: PropertyValueType v
, ValuedPropertyInfo v -> Property -> v
valuedPropertyInfoValue :: Property -> v
, ValuedPropertyInfo v -> v -> Property
valuedPropertyInfoBuilder :: v -> Property
}
instance Descriptor (ValuedPropertyInfo v) where
propertyName :: ValuedPropertyInfo v -> String
propertyName = ValuedPropertyInfo v -> String
forall v. ValuedPropertyInfo v -> String
valuedPropertyInfoName
propertyType :: ValuedPropertyInfo v -> PropertyType
propertyType = ValuedPropertyInfo v -> PropertyType
forall v. ValuedPropertyInfo v -> PropertyType
valuedPropertyInfoType
propertyInherited :: ValuedPropertyInfo v -> Bool
propertyInherited = ValuedPropertyInfo v -> Bool
forall v. ValuedPropertyInfo v -> Bool
valuedPropertyInfoInherited
propertyPredicate :: ValuedPropertyInfo v -> Property -> Bool
propertyPredicate = ValuedPropertyInfo v -> Property -> Bool
forall v. ValuedPropertyInfo v -> Property -> Bool
valuedPropertyInfoPredicate
propertyValueParser :: ValuedPropertyInfo v -> Parser Property
propertyValueParser ValuedPropertyInfo v
descriptor =
(v -> Property) -> ParsecT String () Identity v -> Parser Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ValuedPropertyInfo v -> v -> Property
forall v. ValuedPropertyInfo v -> v -> Property
valuedPropertyInfoBuilder ValuedPropertyInfo v
descriptor) (ParsecT String () Identity v -> Parser Property)
-> ParsecT String () Identity v -> Parser Property
forall a b. (a -> b) -> a -> b
$
PropertyValueType v -> ParsecT String () Identity v
forall a. PropertyValueType a -> Parser a
pvtParser (PropertyValueType v -> ParsecT String () Identity v)
-> PropertyValueType v -> ParsecT String () Identity v
forall a b. (a -> b) -> a -> b
$
ValuedPropertyInfo v -> PropertyValueType v
forall v. ValuedPropertyInfo v -> PropertyValueType v
valuedPropertyInfoValueType ValuedPropertyInfo v
descriptor
propertyValueRenderer :: ValuedPropertyInfo v -> Property -> Render ()
propertyValueRenderer ValuedPropertyInfo v
descriptor Property
property =
PropertyValueType v -> v -> Render ()
forall a. PropertyValueType a -> a -> Render ()
pvtRenderer (ValuedPropertyInfo v -> PropertyValueType v
forall v. ValuedPropertyInfo v -> PropertyValueType v
valuedPropertyInfoValueType ValuedPropertyInfo v
descriptor) (v -> Render ()) -> v -> Render ()
forall a b. (a -> b) -> a -> b
$
ValuedPropertyInfo v -> Property -> v
forall v. ValuedPropertyInfo v -> Property -> v
valuedPropertyInfoValue ValuedPropertyInfo v
descriptor Property
property
propertyValueRendererPretty :: ValuedPropertyInfo v -> Property -> Render ()
propertyValueRendererPretty ValuedPropertyInfo v
descriptor Property
property =
PropertyValueType v -> v -> Render ()
forall a. PropertyValueType a -> a -> Render ()
pvtRendererPretty (ValuedPropertyInfo v -> PropertyValueType v
forall v. ValuedPropertyInfo v -> PropertyValueType v
valuedPropertyInfoValueType ValuedPropertyInfo v
descriptor) (v -> Render ()) -> v -> Render ()
forall a b. (a -> b) -> a -> b
$
ValuedPropertyInfo v -> Property -> v
forall v. ValuedPropertyInfo v -> Property -> v
valuedPropertyInfoValue ValuedPropertyInfo v
descriptor Property
property
instance Eq v => ValuedDescriptor v (ValuedPropertyInfo v) where
propertyValue :: ValuedPropertyInfo v -> Property -> v
propertyValue = ValuedPropertyInfo v -> Property -> v
forall v. ValuedPropertyInfo v -> Property -> v
valuedPropertyInfoValue
propertyBuilder :: ValuedPropertyInfo v -> v -> Property
propertyBuilder = ValuedPropertyInfo v -> v -> Property
forall v. ValuedPropertyInfo v -> v -> Property
valuedPropertyInfoBuilder
defProperty :: String
-> Name
-> Bool
-> DecsQ
defProperty :: String -> Name -> Bool -> DecsQ
defProperty String
name Name
propType Bool
inherited = do
let propName :: Name
propName = String -> Name
mkName String
name
varName :: Name
varName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"property" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
[Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [
Name -> TypeQ -> Q Dec
sigD Name
varName (TypeQ -> Q Dec) -> TypeQ -> Q Dec
forall a b. (a -> b) -> a -> b
$ Name -> TypeQ
conT (Name -> TypeQ) -> Name -> TypeQ
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"PropertyInfo",
PatQ -> BodyQ -> [Q Dec] -> Q Dec
valD (Name -> PatQ
varP Name
varName)
(ExpQ -> BodyQ
normalB [| PropertyInfo name $(conE propName) $(conE propType) inherited |])
[]
]
defValuedProperty :: String -> Name -> Bool -> Name -> DecsQ
defValuedProperty :: String -> Name -> Bool -> Name -> DecsQ
defValuedProperty String
name Name
propType Bool
inherited Name
valueType = do
let propName :: Name
propName = String -> Name
mkName String
name
varName :: Name
varName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"property" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
Name
foo <- String -> Q Name
newName String
"foo"
Name
bar <- String -> Q Name
newName String
"bar"
#if MIN_VERSION_template_haskell(2,11,0)
DataConI Name
_ (AppT (AppT Type
_ Type
haskellValueType) Type
_) Name
_ <- Name -> Q Info
reify Name
propName
#else
DataConI _ (AppT (AppT _ haskellValueType) _) _ _ <- reify propName
#endif
[Q Dec] -> DecsQ
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [
Name -> TypeQ -> Q Dec
sigD Name
varName (TypeQ -> Q Dec) -> TypeQ -> Q Dec
forall a b. (a -> b) -> a -> b
$ TypeQ -> TypeQ -> TypeQ
appT (Name -> TypeQ
conT ''ValuedPropertyInfo) (TypeQ -> TypeQ) -> TypeQ -> TypeQ
forall a b. (a -> b) -> a -> b
$ Type -> TypeQ
forall (m :: * -> *) a. Monad m => a -> m a
return Type
haskellValueType,
PatQ -> BodyQ -> [Q Dec] -> Q Dec
valD (Name -> PatQ
varP Name
varName)
(ExpQ -> BodyQ
normalB [| ValuedPropertyInfo
name
$(conE propType)
inherited
$(lam1E (varP foo) $ caseE (varE foo)
[match (recP propName [])
(normalB $ conE $ mkName "True")
[],
match wildP (normalB $ conE $ mkName "False") []])
$(varE valueType)
$(lam1E (varP foo) $ caseE (varE foo)
[match (conP propName [varP bar]) (normalB $ varE bar) [],
match wildP
(normalB
[| error $ "Property value getter for " ++ $(stringE name) ++
" applied to " ++ show $(varE foo) ++ "." |])
[]])
$(lam1E (varP foo) $ appE (conE propName) (varE foo))
|])
[]
]