-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Types for styling custom entity attributes
module Swarm.Game.Scenario.Style where

import Data.Aeson
import Data.Set (Set)
import Data.Text (Text)
import GHC.Generics (Generic)

data StyleFlag
  = Standout
  | Italic
  | Strikethrough
  | Underline
  | ReverseVideo
  | Blink
  | Dim
  | Bold
  deriving (StyleFlag -> StyleFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyleFlag -> StyleFlag -> Bool
$c/= :: StyleFlag -> StyleFlag -> Bool
== :: StyleFlag -> StyleFlag -> Bool
$c== :: StyleFlag -> StyleFlag -> Bool
Eq, Eq StyleFlag
StyleFlag -> StyleFlag -> Bool
StyleFlag -> StyleFlag -> Ordering
StyleFlag -> StyleFlag -> StyleFlag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StyleFlag -> StyleFlag -> StyleFlag
$cmin :: StyleFlag -> StyleFlag -> StyleFlag
max :: StyleFlag -> StyleFlag -> StyleFlag
$cmax :: StyleFlag -> StyleFlag -> StyleFlag
>= :: StyleFlag -> StyleFlag -> Bool
$c>= :: StyleFlag -> StyleFlag -> Bool
> :: StyleFlag -> StyleFlag -> Bool
$c> :: StyleFlag -> StyleFlag -> Bool
<= :: StyleFlag -> StyleFlag -> Bool
$c<= :: StyleFlag -> StyleFlag -> Bool
< :: StyleFlag -> StyleFlag -> Bool
$c< :: StyleFlag -> StyleFlag -> Bool
compare :: StyleFlag -> StyleFlag -> Ordering
$ccompare :: StyleFlag -> StyleFlag -> Ordering
Ord, Int -> StyleFlag -> ShowS
[StyleFlag] -> ShowS
StyleFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyleFlag] -> ShowS
$cshowList :: [StyleFlag] -> ShowS
show :: StyleFlag -> String
$cshow :: StyleFlag -> String
showsPrec :: Int -> StyleFlag -> ShowS
$cshowsPrec :: Int -> StyleFlag -> ShowS
Show, forall x. Rep StyleFlag x -> StyleFlag
forall x. StyleFlag -> Rep StyleFlag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StyleFlag x -> StyleFlag
$cfrom :: forall x. StyleFlag -> Rep StyleFlag x
Generic)

styleFlagJsonOptions :: Options
styleFlagJsonOptions :: Options
styleFlagJsonOptions =
  Options
defaultOptions
    { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue
    }

instance FromJSON StyleFlag where
  parseJSON :: Value -> Parser StyleFlag
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
styleFlagJsonOptions

instance ToJSON StyleFlag where
  toJSON :: StyleFlag -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
styleFlagJsonOptions

-- | Hexadecimal color notation.
-- May include a leading hash symbol (see 'Data.Colour.SRGB.sRGB24read').
newtype HexColor = HexColor Text
  deriving (HexColor -> HexColor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HexColor -> HexColor -> Bool
$c/= :: HexColor -> HexColor -> Bool
== :: HexColor -> HexColor -> Bool
$c== :: HexColor -> HexColor -> Bool
Eq, Int -> HexColor -> ShowS
[HexColor] -> ShowS
HexColor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HexColor] -> ShowS
$cshowList :: [HexColor] -> ShowS
show :: HexColor -> String
$cshow :: HexColor -> String
showsPrec :: Int -> HexColor -> ShowS
$cshowsPrec :: Int -> HexColor -> ShowS
Show, forall x. Rep HexColor x -> HexColor
forall x. HexColor -> Rep HexColor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HexColor x -> HexColor
$cfrom :: forall x. HexColor -> Rep HexColor x
Generic, Value -> Parser [HexColor]
Value -> Parser HexColor
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [HexColor]
$cparseJSONList :: Value -> Parser [HexColor]
parseJSON :: Value -> Parser HexColor
$cparseJSON :: Value -> Parser HexColor
FromJSON, [HexColor] -> Encoding
[HexColor] -> Value
HexColor -> Encoding
HexColor -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [HexColor] -> Encoding
$ctoEncodingList :: [HexColor] -> Encoding
toJSONList :: [HexColor] -> Value
$ctoJSONList :: [HexColor] -> Value
toEncoding :: HexColor -> Encoding
$ctoEncoding :: HexColor -> Encoding
toJSON :: HexColor -> Value
$ctoJSON :: HexColor -> Value
ToJSON)

data CustomAttr = CustomAttr
  { CustomAttr -> String
name :: String
  , CustomAttr -> Maybe HexColor
fg :: Maybe HexColor
  , CustomAttr -> Maybe HexColor
bg :: Maybe HexColor
  , CustomAttr -> Maybe (Set StyleFlag)
style :: Maybe (Set StyleFlag)
  }
  deriving (CustomAttr -> CustomAttr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomAttr -> CustomAttr -> Bool
$c/= :: CustomAttr -> CustomAttr -> Bool
== :: CustomAttr -> CustomAttr -> Bool
$c== :: CustomAttr -> CustomAttr -> Bool
Eq, Int -> CustomAttr -> ShowS
[CustomAttr] -> ShowS
CustomAttr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomAttr] -> ShowS
$cshowList :: [CustomAttr] -> ShowS
show :: CustomAttr -> String
$cshow :: CustomAttr -> String
showsPrec :: Int -> CustomAttr -> ShowS
$cshowsPrec :: Int -> CustomAttr -> ShowS
Show, forall x. Rep CustomAttr x -> CustomAttr
forall x. CustomAttr -> Rep CustomAttr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CustomAttr x -> CustomAttr
$cfrom :: forall x. CustomAttr -> Rep CustomAttr x
Generic, Value -> Parser [CustomAttr]
Value -> Parser CustomAttr
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CustomAttr]
$cparseJSONList :: Value -> Parser [CustomAttr]
parseJSON :: Value -> Parser CustomAttr
$cparseJSON :: Value -> Parser CustomAttr
FromJSON)

instance ToJSON CustomAttr where
  toJSON :: CustomAttr -> Value
toJSON =
    forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      Options
defaultOptions
        { omitNothingFields :: Bool
omitNothingFields = Bool
True
        }