-- This file is part of Goatee.
--
-- Copyright 2014-2021 Bryan Gardiner
--
-- Goatee is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Goatee is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with Goatee.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Property metadata declarations.
--
-- Import "Game.Goatee.Lib.Property" rather than importing this module.
module Game.Goatee.Lib.Property.Info (
  -- * Known property metadata
  propertyB,
  propertyKO,
  propertyMN,
  propertyW,

  propertyAB,
  propertyAE,
  propertyAW,
  propertyPL,

  propertyC,
  propertyDM,
  propertyGB,
  propertyGW,
  propertyHO,
  propertyN,
  propertyUC,
  propertyV,

  propertyBM,
  propertyDO,
  propertyIT,
  propertyTE,

  propertyAR,
  propertyCR,
  propertyDD,
  propertyLB,
  propertyLN,
  propertyMA,
  propertySL,
  propertySQ,
  propertyTR,

  propertyAP,
  propertyCA,
  propertyFF,
  propertyGM,
  propertyST,
  propertySZ,

  propertyAN,
  propertyBR,
  propertyBT,
  propertyCP,
  propertyDT,
  propertyEV,
  propertyGC,
  propertyGN,
  propertyON,
  propertyOT,
  propertyPB,
  propertyPC,
  propertyPW,
  propertyRE,
  propertyRO,
  propertyRU,
  propertySO,
  propertyTM,
  propertyUS,
  propertyWR,
  propertyWT,

  propertyBL,
  propertyOB,
  propertyOW,
  propertyWL,

  propertyVW,

  propertyHA,
  propertyKM,
  propertyTB,
  propertyTW,

  -- * Property metadata utilities
  allKnownDescriptors,
  propertyUnknown,
  propertyInfo,
  descriptorForName, descriptorForName',
  stoneAssignmentProperties, stoneAssignmentPropertyToStone, stoneToStoneAssignmentProperty,
  markProperty,
  ) where

import Control.Arrow ((&&&))
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Game.Goatee.Lib.Property.Base
import Game.Goatee.Lib.Property.Value
import Game.Goatee.Lib.Types

-- Move properties.
$(defValuedProperty "B" 'MoveProperty False 'movePvt)
$(defProperty "KO" 'MoveProperty False)
$(defValuedProperty "MN" 'MoveProperty False 'integralPvt)
$(defValuedProperty "W" 'MoveProperty False 'movePvt)

-- Setup properties.
$(defValuedProperty "AB" 'SetupProperty False 'coordListPvt)
$(defValuedProperty "AE" 'SetupProperty False 'coordListPvt)
$(defValuedProperty "AW" 'SetupProperty False 'coordListPvt)
$(defValuedProperty "PL" 'SetupProperty False 'colorPvt)

-- Node annotation properties.
$(defValuedProperty "C" 'GeneralProperty False 'textPvt)
$(defValuedProperty "DM" 'GeneralProperty False 'doublePvt)
$(defValuedProperty "GB" 'GeneralProperty False 'doublePvt)
$(defValuedProperty "GW" 'GeneralProperty False 'doublePvt)
$(defValuedProperty "HO" 'GeneralProperty False 'doublePvt)
$(defValuedProperty "N" 'GeneralProperty False 'simpleTextPvt)
$(defValuedProperty "UC" 'GeneralProperty False 'doublePvt)
$(defValuedProperty "V" 'GeneralProperty False 'realPvt)

-- Move annotation properties.
$(defValuedProperty "BM" 'MoveProperty False 'doublePvt)
$(defProperty "DO" 'MoveProperty False)
$(defProperty "IT" 'MoveProperty False)
$(defValuedProperty "TE" 'MoveProperty False 'doublePvt)

-- Markup properties.
$(defValuedProperty "AR" 'GeneralProperty False 'coordPairListPvt)
$(defValuedProperty "CR" 'GeneralProperty False 'coordListPvt)
$(defValuedProperty "DD" 'GeneralProperty True 'coordListPvt)
$(defValuedProperty "LB" 'GeneralProperty False 'labelListPvt)
$(defValuedProperty "LN" 'GeneralProperty False 'lineListPvt)
$(defValuedProperty "MA" 'GeneralProperty False 'coordListPvt)
$(defValuedProperty "SL" 'GeneralProperty False 'coordListPvt)
$(defValuedProperty "SQ" 'GeneralProperty False 'coordListPvt)
$(defValuedProperty "TR" 'GeneralProperty False 'coordListPvt)

-- Root properties.
propertyAP :: ValuedPropertyInfo (SimpleText, SimpleText)
propertyAP :: ValuedPropertyInfo (SimpleText, SimpleText)
propertyAP = String
-> PropertyType
-> Bool
-> (Property -> Bool)
-> PropertyValueType (SimpleText, SimpleText)
-> (Property -> (SimpleText, SimpleText))
-> ((SimpleText, SimpleText) -> Property)
-> ValuedPropertyInfo (SimpleText, SimpleText)
forall v.
String
-> PropertyType
-> Bool
-> (Property -> Bool)
-> PropertyValueType v
-> (Property -> v)
-> (v -> Property)
-> ValuedPropertyInfo v
ValuedPropertyInfo String
"AP" PropertyType
RootProperty Bool
False
             (\Property
x -> case Property
x of { AP {} -> Bool
True; Property
_ -> Bool
False })
             PropertyValueType (SimpleText, SimpleText)
simpleTextPairPvt
             (\(AP SimpleText
x SimpleText
y) -> (SimpleText
x, SimpleText
y))
             ((SimpleText -> SimpleText -> Property)
-> (SimpleText, SimpleText) -> Property
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SimpleText -> SimpleText -> Property
AP)
$(defValuedProperty "CA" 'RootProperty False 'simpleTextPvt)
$(defValuedProperty "FF" 'RootProperty False 'integralPvt)  -- TODO Add parser validation.
$(defValuedProperty "GM" 'RootProperty False 'integralPvt)  -- TODO Add parser validation.
$(defValuedProperty "ST" 'RootProperty False 'variationModePvt)
propertySZ :: ValuedPropertyInfo (Int, Int)
propertySZ :: ValuedPropertyInfo Coord
propertySZ = String
-> PropertyType
-> Bool
-> (Property -> Bool)
-> PropertyValueType Coord
-> (Property -> Coord)
-> (Coord -> Property)
-> ValuedPropertyInfo Coord
forall v.
String
-> PropertyType
-> Bool
-> (Property -> Bool)
-> PropertyValueType v
-> (Property -> v)
-> (v -> Property)
-> ValuedPropertyInfo v
ValuedPropertyInfo String
"SZ" PropertyType
RootProperty Bool
False
             (\Property
x -> case Property
x of { SZ {} -> Bool
True; Property
_ -> Bool
False })
             PropertyValueType Coord
sizePvt
             (\(SZ Int
x Int
y) -> (Int
x, Int
y))
             ((Int -> Int -> Property) -> Coord -> Property
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Property
SZ)

-- Game info properties.
$(defValuedProperty "AN" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "BR" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "BT" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "CP" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "DT" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "EV" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "GC" 'GameInfoProperty False 'textPvt)
$(defValuedProperty "GN" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "ON" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "OT" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "PB" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "PC" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "PW" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "RE" 'GameInfoProperty False 'gameResultPvt)
$(defValuedProperty "RO" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "RU" 'GameInfoProperty False 'rulesetPvt)
$(defValuedProperty "SO" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "TM" 'GameInfoProperty False 'realPvt)
$(defValuedProperty "US" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "WR" 'GameInfoProperty False 'simpleTextPvt)
$(defValuedProperty "WT" 'GameInfoProperty False 'simpleTextPvt)

-- Timing properties.
$(defValuedProperty "BL" 'MoveProperty False 'realPvt)
$(defValuedProperty "OB" 'MoveProperty False 'integralPvt)
$(defValuedProperty "OW" 'MoveProperty False 'integralPvt)
$(defValuedProperty "WL" 'MoveProperty False 'realPvt)

-- Miscellaneous properties.
$(defValuedProperty "VW" 'GeneralProperty True 'coordElistPvt)

-- Go-specific properties.
$(defValuedProperty "HA" 'GameInfoProperty False 'integralPvt)
$(defValuedProperty "KM" 'GameInfoProperty False 'realPvt)
$(defValuedProperty "TB" 'GeneralProperty False 'coordElistPvt)
$(defValuedProperty "TW" 'GeneralProperty False 'coordElistPvt)

-- | A list of descriptors for all known 'Property's.
allKnownDescriptors :: [AnyDescriptor]
allKnownDescriptors :: [AnyDescriptor]
allKnownDescriptors =
  [ ValuedPropertyInfo (Maybe Coord) -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo (Maybe Coord)
propertyB
  , PropertyInfo -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor PropertyInfo
propertyKO
  , ValuedPropertyInfo Integer -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Integer
propertyMN
  , ValuedPropertyInfo (Maybe Coord) -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo (Maybe Coord)
propertyW

  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyAB
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyAE
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyAW
  , ValuedPropertyInfo Color -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Color
propertyPL

  , ValuedPropertyInfo Text -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Text
propertyC
  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyDM
  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyGB
  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyGW
  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyHO
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyN
  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyUC
  , ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyV

  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyBM
  , PropertyInfo -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor PropertyInfo
propertyDO
  , PropertyInfo -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor PropertyInfo
propertyIT
  , ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyTE

  , ValuedPropertyInfo ArrowList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo ArrowList
propertyAR
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyCR
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyDD
  , ValuedPropertyInfo LabelList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo LabelList
propertyLB
  , ValuedPropertyInfo LineList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo LineList
propertyLN
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyMA
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertySL
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertySQ
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyTR

  , ValuedPropertyInfo (SimpleText, SimpleText) -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo (SimpleText, SimpleText)
propertyAP
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyCA
  , ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyFF
  , ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyGM
  , ValuedPropertyInfo VariationMode -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo VariationMode
propertyST
  , ValuedPropertyInfo Coord -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Coord
propertySZ

  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyAN
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyBR
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyBT
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyCP
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyDT
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyEV
  , ValuedPropertyInfo Text -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Text
propertyGC
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyGN
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyON
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyOT
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyPB
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyPC
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyPW
  , ValuedPropertyInfo GameResult -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo GameResult
propertyRE
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyRO
  , ValuedPropertyInfo Ruleset -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Ruleset
propertyRU
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertySO
  , ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyTM
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyUS
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyWR
  , ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyWT

  , ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyBL
  , ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyOB
  , ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyOW
  , ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyWL

  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyVW

  , ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyHA
  , ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyKM
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyTB
  , ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyTW
  ]

-- | Builds a 'ValuedPropertyInfo' for an unknown property with the given name.
-- /Does not check that the name is actually unknown./
propertyUnknown :: String -> ValuedPropertyInfo UnknownPropertyValue
propertyUnknown :: String -> ValuedPropertyInfo UnknownPropertyValue
propertyUnknown String
name =
  String
-> PropertyType
-> Bool
-> (Property -> Bool)
-> PropertyValueType UnknownPropertyValue
-> (Property -> UnknownPropertyValue)
-> (UnknownPropertyValue -> Property)
-> ValuedPropertyInfo UnknownPropertyValue
forall v.
String
-> PropertyType
-> Bool
-> (Property -> Bool)
-> PropertyValueType v
-> (Property -> v)
-> (v -> Property)
-> ValuedPropertyInfo v
ValuedPropertyInfo String
name PropertyType
GeneralProperty Bool
False
  (\Property
x -> case Property
x of
      UnknownProperty String
name' UnknownPropertyValue
_ | String
name' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name -> Bool
True
      Property
_ -> Bool
False)
  PropertyValueType UnknownPropertyValue
unknownPropertyPvt
  (\(UnknownProperty String
_ UnknownPropertyValue
value) -> UnknownPropertyValue
value)
  (String -> UnknownPropertyValue -> Property
UnknownProperty String
name)

-- | Returns a descriptor for any 'Property', known or unknown.  Because a
-- 'Property' has a 'Descriptor' instance, this function is not normally
-- necessary for use outside of this module, but it can be used to throw away a
-- value associated with a 'Property' and retain only the metadata.
propertyInfo :: Property -> AnyDescriptor
propertyInfo :: Property -> AnyDescriptor
propertyInfo Property
property = case Property
property of
  B {} -> ValuedPropertyInfo (Maybe Coord) -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo (Maybe Coord)
propertyB
  KO {} -> PropertyInfo -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor PropertyInfo
propertyKO
  MN {} -> ValuedPropertyInfo Integer -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Integer
propertyMN
  W {} -> ValuedPropertyInfo (Maybe Coord) -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo (Maybe Coord)
propertyW

  AB {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyAB
  AE {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyAE
  AW {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyAW
  PL {} -> ValuedPropertyInfo Color -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Color
propertyPL

  C {} -> ValuedPropertyInfo Text -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Text
propertyC
  DM {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyDM
  GB {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyGB
  GW {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyGW
  HO {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyHO
  N {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyN
  UC {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyUC
  V {} -> ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyV

  BM {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyBM
  DO {} -> PropertyInfo -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor PropertyInfo
propertyDO
  IT {} -> PropertyInfo -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor PropertyInfo
propertyIT
  TE {} -> ValuedPropertyInfo DoubleValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo DoubleValue
propertyTE

  AR {} -> ValuedPropertyInfo ArrowList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo ArrowList
propertyAR
  CR {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyCR
  DD {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyDD
  LB {} -> ValuedPropertyInfo LabelList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo LabelList
propertyLB
  LN {} -> ValuedPropertyInfo LineList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo LineList
propertyLN
  MA {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyMA
  SL {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertySL
  SQ {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertySQ
  TR {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyTR

  AP {} -> ValuedPropertyInfo (SimpleText, SimpleText) -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo (SimpleText, SimpleText)
propertyAP
  CA {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyCA
  FF {} -> ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyFF
  GM {} -> ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyGM
  ST {} -> ValuedPropertyInfo VariationMode -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo VariationMode
propertyST
  SZ {} -> ValuedPropertyInfo Coord -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Coord
propertySZ

  AN {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyAN
  BR {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyBR
  BT {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyBT
  CP {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyCP
  DT {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyDT
  EV {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyEV
  GC {} -> ValuedPropertyInfo Text -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Text
propertyGC
  GN {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyGN
  ON {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyON
  OT {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyOT
  PB {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyPB
  PC {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyPC
  PW {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyPW
  RE {} -> ValuedPropertyInfo GameResult -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo GameResult
propertyRE
  RO {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyRO
  RU {} -> ValuedPropertyInfo Ruleset -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Ruleset
propertyRU
  SO {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertySO
  TM {} -> ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyTM
  US {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyUS
  WR {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyWR
  WT {} -> ValuedPropertyInfo SimpleText -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo SimpleText
propertyWT

  BL {} -> ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyBL
  OB {} -> ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyOB
  OW {} -> ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyOW
  WL {} -> ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyWL

  VW {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyVW

  HA {} -> ValuedPropertyInfo Int -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo Int
propertyHA
  KM {} -> ValuedPropertyInfo RealValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo RealValue
propertyKM
  TB {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyTB
  TW {} -> ValuedPropertyInfo CoordList -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor ValuedPropertyInfo CoordList
propertyTW

  UnknownProperty String
name UnknownPropertyValue
_ -> ValuedPropertyInfo UnknownPropertyValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor (ValuedPropertyInfo UnknownPropertyValue -> AnyDescriptor)
-> ValuedPropertyInfo UnknownPropertyValue -> AnyDescriptor
forall a b. (a -> b) -> a -> b
$ String -> ValuedPropertyInfo UnknownPropertyValue
propertyUnknown String
name

instance Descriptor Property where
  propertyName :: Property -> String
propertyName = AnyDescriptor -> String
forall a. Descriptor a => a -> String
propertyName (AnyDescriptor -> String)
-> (Property -> AnyDescriptor) -> Property -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo
  propertyType :: Property -> PropertyType
propertyType = AnyDescriptor -> PropertyType
forall a. Descriptor a => a -> PropertyType
propertyType (AnyDescriptor -> PropertyType)
-> (Property -> AnyDescriptor) -> Property -> PropertyType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo
  propertyInherited :: Property -> Bool
propertyInherited = AnyDescriptor -> Bool
forall a. Descriptor a => a -> Bool
propertyInherited (AnyDescriptor -> Bool)
-> (Property -> AnyDescriptor) -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo
  propertyPredicate :: Property -> Property -> Bool
propertyPredicate = AnyDescriptor -> Property -> Bool
forall a. Descriptor a => a -> Property -> Bool
propertyPredicate (AnyDescriptor -> Property -> Bool)
-> (Property -> AnyDescriptor) -> Property -> Property -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo
  propertyValueParser :: Property -> Parser Property
propertyValueParser = AnyDescriptor -> Parser Property
forall a. Descriptor a => a -> Parser Property
propertyValueParser (AnyDescriptor -> Parser Property)
-> (Property -> AnyDescriptor) -> Property -> Parser Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo
  propertyValueRenderer :: Property -> Property -> Render ()
propertyValueRenderer = AnyDescriptor -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRenderer (AnyDescriptor -> Property -> Render ())
-> (Property -> AnyDescriptor) -> Property -> Property -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo
  propertyValueRendererPretty :: Property -> Property -> Render ()
propertyValueRendererPretty = AnyDescriptor -> Property -> Render ()
forall a. Descriptor a => a -> Property -> Render ()
propertyValueRendererPretty (AnyDescriptor -> Property -> Render ())
-> (Property -> AnyDescriptor) -> Property -> Property -> Render ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> AnyDescriptor
propertyInfo

descriptorsByName :: Map String AnyDescriptor
descriptorsByName :: Map String AnyDescriptor
descriptorsByName = [(String, AnyDescriptor)] -> Map String AnyDescriptor
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, AnyDescriptor)] -> Map String AnyDescriptor)
-> [(String, AnyDescriptor)] -> Map String AnyDescriptor
forall a b. (a -> b) -> a -> b
$ (AnyDescriptor -> (String, AnyDescriptor))
-> [AnyDescriptor] -> [(String, AnyDescriptor)]
forall a b. (a -> b) -> [a] -> [b]
map (AnyDescriptor -> String
forall a. Descriptor a => a -> String
propertyName (AnyDescriptor -> String)
-> (AnyDescriptor -> AnyDescriptor)
-> AnyDescriptor
-> (String, AnyDescriptor)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& AnyDescriptor -> AnyDescriptor
forall a. a -> a
id) [AnyDescriptor]
allKnownDescriptors

-- | Returns a descriptor for the given property name.  The name does not have
-- to be for a known property; an unknown property will use 'propertyUnknown'.
descriptorForName :: String -> AnyDescriptor
descriptorForName :: String -> AnyDescriptor
descriptorForName String
name = AnyDescriptor -> Maybe AnyDescriptor -> AnyDescriptor
forall a. a -> Maybe a -> a
fromMaybe (ValuedPropertyInfo UnknownPropertyValue -> AnyDescriptor
forall a. Descriptor a => a -> AnyDescriptor
AnyDescriptor (ValuedPropertyInfo UnknownPropertyValue -> AnyDescriptor)
-> ValuedPropertyInfo UnknownPropertyValue -> AnyDescriptor
forall a b. (a -> b) -> a -> b
$ String -> ValuedPropertyInfo UnknownPropertyValue
propertyUnknown String
name) (Maybe AnyDescriptor -> AnyDescriptor)
-> Maybe AnyDescriptor -> AnyDescriptor
forall a b. (a -> b) -> a -> b
$ String -> Maybe AnyDescriptor
descriptorForName' String
name

-- | Returns a descriptor for a known property with the given name, or 'Nothing'
-- if the name does not belong to a known property.
descriptorForName' :: String -> Maybe AnyDescriptor
descriptorForName' :: String -> Maybe AnyDescriptor
descriptorForName' = (String -> Map String AnyDescriptor -> Maybe AnyDescriptor)
-> Map String AnyDescriptor -> String -> Maybe AnyDescriptor
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String AnyDescriptor -> Maybe AnyDescriptor
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map String AnyDescriptor
descriptorsByName

-- | Descriptors for setup properties that assign stones to the board.  For use
-- with 'stoneAssignmentPropertyToStone' and 'stoneToStoneAssignmentProperty'.
stoneAssignmentProperties :: [AnyCoordListDescriptor]
stoneAssignmentProperties :: [AnyCoordListDescriptor]
stoneAssignmentProperties =
  [ ValuedPropertyInfo CoordList -> AnyCoordListDescriptor
forall v a. ValuedDescriptor v a => a -> AnyValuedDescriptor v
AnyValuedDescriptor ValuedPropertyInfo CoordList
propertyAB
  , ValuedPropertyInfo CoordList -> AnyCoordListDescriptor
forall v a. ValuedDescriptor v a => a -> AnyValuedDescriptor v
AnyValuedDescriptor ValuedPropertyInfo CoordList
propertyAE
  , ValuedPropertyInfo CoordList -> AnyCoordListDescriptor
forall v a. ValuedDescriptor v a => a -> AnyValuedDescriptor v
AnyValuedDescriptor ValuedPropertyInfo CoordList
propertyAW
  ]

-- | Converts a descriptor in 'stoneAssignmentProperties' to the type of stone
-- it assigns.
stoneAssignmentPropertyToStone :: AnyCoordListDescriptor -> Maybe Color
stoneAssignmentPropertyToStone :: AnyCoordListDescriptor -> Maybe Color
stoneAssignmentPropertyToStone (AnyValuedDescriptor a
d) = case a -> String
forall a. Descriptor a => a -> String
propertyName a
d of
  String
"AB" -> Color -> Maybe Color
forall a. a -> Maybe a
Just Color
Black
  String
"AE" -> Maybe Color
forall a. Maybe a
Nothing
  String
"AW" -> Color -> Maybe Color
forall a. a -> Maybe a
Just Color
White
  String
_ -> String -> Maybe Color
forall a. HasCallStack => String -> a
error (String -> Maybe Color) -> String -> Maybe Color
forall a b. (a -> b) -> a -> b
$ String
"stoneAssignmentPropertyToColor: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show (a -> String
forall a. Descriptor a => a -> String
propertyName a
d) String -> String -> String
forall a. [a] -> [a] -> [a]
++
       String
" is not a stone assignment property."

-- | Converts a type of stone assignment to a descriptor in
-- 'stoneAssignmentProperties'.
stoneToStoneAssignmentProperty :: Maybe Color -> AnyCoordListDescriptor
stoneToStoneAssignmentProperty :: Maybe Color -> AnyCoordListDescriptor
stoneToStoneAssignmentProperty Maybe Color
stone = case Maybe Color
stone of
  Maybe Color
Nothing -> ValuedPropertyInfo CoordList -> AnyCoordListDescriptor
forall v a. ValuedDescriptor v a => a -> AnyValuedDescriptor v
AnyValuedDescriptor ValuedPropertyInfo CoordList
propertyAE
  Just Color
Black -> ValuedPropertyInfo CoordList -> AnyCoordListDescriptor
forall v a. ValuedDescriptor v a => a -> AnyValuedDescriptor v
AnyValuedDescriptor ValuedPropertyInfo CoordList
propertyAB
  Just Color
White -> ValuedPropertyInfo CoordList -> AnyCoordListDescriptor
forall v a. ValuedDescriptor v a => a -> AnyValuedDescriptor v
AnyValuedDescriptor ValuedPropertyInfo CoordList
propertyAW

-- | Returns the descriptor for a mark.
markProperty :: Mark -> ValuedPropertyInfo CoordList
markProperty :: Mark -> ValuedPropertyInfo CoordList
markProperty Mark
MarkCircle = ValuedPropertyInfo CoordList
propertyCR
markProperty Mark
MarkSelected = ValuedPropertyInfo CoordList
propertySL
markProperty Mark
MarkSquare = ValuedPropertyInfo CoordList
propertySQ
markProperty Mark
MarkTriangle = ValuedPropertyInfo CoordList
propertyTR
markProperty Mark
MarkX = ValuedPropertyInfo CoordList
propertyMA