{-# LANGUAGE DeriveGeneric #-}
-- | Abstract syntax of human player commands.
module Game.LambdaHack.Client.UI.HumanCmd
  ( CmdCategory(..), categoryDescription
  , CmdArea(..), areaDescription
  , CmdTriple, AimModeCmd(..), HumanCmd(..)
  , TriggerItem(..)
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Control.DeepSeq
import           Data.Binary
import           GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU

import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Definition.Defs

data CmdCategory =
    CmdMainMenu | CmdDashboard | CmdItemMenu
  | CmdMove | CmdItem | CmdAim | CmdMeta | CmdMouse
  | CmdInternal | CmdDebug | CmdMinimal
  deriving (Int -> CmdCategory -> ShowS
[CmdCategory] -> ShowS
CmdCategory -> String
(Int -> CmdCategory -> ShowS)
-> (CmdCategory -> String)
-> ([CmdCategory] -> ShowS)
-> Show CmdCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdCategory] -> ShowS
$cshowList :: [CmdCategory] -> ShowS
show :: CmdCategory -> String
$cshow :: CmdCategory -> String
showsPrec :: Int -> CmdCategory -> ShowS
$cshowsPrec :: Int -> CmdCategory -> ShowS
Show, ReadPrec [CmdCategory]
ReadPrec CmdCategory
Int -> ReadS CmdCategory
ReadS [CmdCategory]
(Int -> ReadS CmdCategory)
-> ReadS [CmdCategory]
-> ReadPrec CmdCategory
-> ReadPrec [CmdCategory]
-> Read CmdCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CmdCategory]
$creadListPrec :: ReadPrec [CmdCategory]
readPrec :: ReadPrec CmdCategory
$creadPrec :: ReadPrec CmdCategory
readList :: ReadS [CmdCategory]
$creadList :: ReadS [CmdCategory]
readsPrec :: Int -> ReadS CmdCategory
$creadsPrec :: Int -> ReadS CmdCategory
Read, CmdCategory -> CmdCategory -> Bool
(CmdCategory -> CmdCategory -> Bool)
-> (CmdCategory -> CmdCategory -> Bool) -> Eq CmdCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdCategory -> CmdCategory -> Bool
$c/= :: CmdCategory -> CmdCategory -> Bool
== :: CmdCategory -> CmdCategory -> Bool
$c== :: CmdCategory -> CmdCategory -> Bool
Eq, (forall x. CmdCategory -> Rep CmdCategory x)
-> (forall x. Rep CmdCategory x -> CmdCategory)
-> Generic CmdCategory
forall x. Rep CmdCategory x -> CmdCategory
forall x. CmdCategory -> Rep CmdCategory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmdCategory x -> CmdCategory
$cfrom :: forall x. CmdCategory -> Rep CmdCategory x
Generic)

instance NFData CmdCategory

instance Binary CmdCategory

categoryDescription :: CmdCategory -> Text
categoryDescription :: CmdCategory -> Text
categoryDescription CmdMainMenu = "Main menu"
categoryDescription CmdDashboard = "Dashboard"
categoryDescription CmdItemMenu = "Item menu commands"
categoryDescription CmdMove = "Terrain exploration and modification commands"
categoryDescription CmdItem = "All item-related commands"
categoryDescription CmdAim = "All aiming commands"
categoryDescription CmdMeta = "Assorted commands"
categoryDescription CmdMouse = "Mouse"
categoryDescription CmdInternal = "Internal"
categoryDescription CmdDebug = "Debug"
categoryDescription CmdMinimal = "The minimal command set"

-- The constructors are sorted, roughly, wrt inclusion, then top to bottom,
-- the left to right.
-- | Symbolic representation of areas of the screen used to define the meaning
-- of mouse button presses relative to where the mouse points to.
data CmdArea =
    CaMessage
  | CaMapLeader
  | CaMapParty
  | CaMap
  | CaLevelNumber
  | CaArenaName
  | CaPercentSeen
  | CaXhairDesc
  | CaSelected
  | CaCalmGauge
  | CaCalmValue
  | CaHPGauge
  | CaHPValue
  | CaLeaderDesc
  deriving (Int -> CmdArea -> ShowS
[CmdArea] -> ShowS
CmdArea -> String
(Int -> CmdArea -> ShowS)
-> (CmdArea -> String) -> ([CmdArea] -> ShowS) -> Show CmdArea
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmdArea] -> ShowS
$cshowList :: [CmdArea] -> ShowS
show :: CmdArea -> String
$cshow :: CmdArea -> String
showsPrec :: Int -> CmdArea -> ShowS
$cshowsPrec :: Int -> CmdArea -> ShowS
Show, ReadPrec [CmdArea]
ReadPrec CmdArea
Int -> ReadS CmdArea
ReadS [CmdArea]
(Int -> ReadS CmdArea)
-> ReadS [CmdArea]
-> ReadPrec CmdArea
-> ReadPrec [CmdArea]
-> Read CmdArea
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CmdArea]
$creadListPrec :: ReadPrec [CmdArea]
readPrec :: ReadPrec CmdArea
$creadPrec :: ReadPrec CmdArea
readList :: ReadS [CmdArea]
$creadList :: ReadS [CmdArea]
readsPrec :: Int -> ReadS CmdArea
$creadsPrec :: Int -> ReadS CmdArea
Read, CmdArea -> CmdArea -> Bool
(CmdArea -> CmdArea -> Bool)
-> (CmdArea -> CmdArea -> Bool) -> Eq CmdArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdArea -> CmdArea -> Bool
$c/= :: CmdArea -> CmdArea -> Bool
== :: CmdArea -> CmdArea -> Bool
$c== :: CmdArea -> CmdArea -> Bool
Eq, Eq CmdArea
Eq CmdArea =>
(CmdArea -> CmdArea -> Ordering)
-> (CmdArea -> CmdArea -> Bool)
-> (CmdArea -> CmdArea -> Bool)
-> (CmdArea -> CmdArea -> Bool)
-> (CmdArea -> CmdArea -> Bool)
-> (CmdArea -> CmdArea -> CmdArea)
-> (CmdArea -> CmdArea -> CmdArea)
-> Ord CmdArea
CmdArea -> CmdArea -> Bool
CmdArea -> CmdArea -> Ordering
CmdArea -> CmdArea -> CmdArea
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 :: CmdArea -> CmdArea -> CmdArea
$cmin :: CmdArea -> CmdArea -> CmdArea
max :: CmdArea -> CmdArea -> CmdArea
$cmax :: CmdArea -> CmdArea -> CmdArea
>= :: CmdArea -> CmdArea -> Bool
$c>= :: CmdArea -> CmdArea -> Bool
> :: CmdArea -> CmdArea -> Bool
$c> :: CmdArea -> CmdArea -> Bool
<= :: CmdArea -> CmdArea -> Bool
$c<= :: CmdArea -> CmdArea -> Bool
< :: CmdArea -> CmdArea -> Bool
$c< :: CmdArea -> CmdArea -> Bool
compare :: CmdArea -> CmdArea -> Ordering
$ccompare :: CmdArea -> CmdArea -> Ordering
$cp1Ord :: Eq CmdArea
Ord, (forall x. CmdArea -> Rep CmdArea x)
-> (forall x. Rep CmdArea x -> CmdArea) -> Generic CmdArea
forall x. Rep CmdArea x -> CmdArea
forall x. CmdArea -> Rep CmdArea x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CmdArea x -> CmdArea
$cfrom :: forall x. CmdArea -> Rep CmdArea x
Generic)

instance NFData CmdArea

instance Binary CmdArea

areaDescription :: CmdArea -> Text
areaDescription :: CmdArea -> Text
areaDescription ca :: CmdArea
ca = case CmdArea
ca of
  CaMessage ->      "message line"
  CaMapLeader ->    "pointman tile"
  CaMapParty ->     "party on map"
  CaMap ->          "the map area"
  CaLevelNumber ->  "level number"
  CaArenaName ->    "level caption"
  CaPercentSeen ->  "percent seen"
  CaXhairDesc ->    "crosshair info"
  CaSelected ->     "party roster"
  CaCalmGauge ->    "Calm gauge"
  CaCalmValue ->    "Calm value"
  CaHPGauge ->      "HP gauge"
  CaHPValue ->      "HP value"
  CaLeaderDesc ->   "pointman info"
  --                 1234567890123

-- | This triple of command categories, description and the command term itself
-- defines the meaning of a human command as entered via a keypress,
-- mouse click or chosen from a menu.
type CmdTriple = ([CmdCategory], Text, HumanCmd)

data AimModeCmd = AimModeCmd {AimModeCmd -> HumanCmd
exploration :: HumanCmd, AimModeCmd -> HumanCmd
aiming :: HumanCmd}
  deriving (Int -> AimModeCmd -> ShowS
[AimModeCmd] -> ShowS
AimModeCmd -> String
(Int -> AimModeCmd -> ShowS)
-> (AimModeCmd -> String)
-> ([AimModeCmd] -> ShowS)
-> Show AimModeCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AimModeCmd] -> ShowS
$cshowList :: [AimModeCmd] -> ShowS
show :: AimModeCmd -> String
$cshow :: AimModeCmd -> String
showsPrec :: Int -> AimModeCmd -> ShowS
$cshowsPrec :: Int -> AimModeCmd -> ShowS
Show, ReadPrec [AimModeCmd]
ReadPrec AimModeCmd
Int -> ReadS AimModeCmd
ReadS [AimModeCmd]
(Int -> ReadS AimModeCmd)
-> ReadS [AimModeCmd]
-> ReadPrec AimModeCmd
-> ReadPrec [AimModeCmd]
-> Read AimModeCmd
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AimModeCmd]
$creadListPrec :: ReadPrec [AimModeCmd]
readPrec :: ReadPrec AimModeCmd
$creadPrec :: ReadPrec AimModeCmd
readList :: ReadS [AimModeCmd]
$creadList :: ReadS [AimModeCmd]
readsPrec :: Int -> ReadS AimModeCmd
$creadsPrec :: Int -> ReadS AimModeCmd
Read, AimModeCmd -> AimModeCmd -> Bool
(AimModeCmd -> AimModeCmd -> Bool)
-> (AimModeCmd -> AimModeCmd -> Bool) -> Eq AimModeCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AimModeCmd -> AimModeCmd -> Bool
$c/= :: AimModeCmd -> AimModeCmd -> Bool
== :: AimModeCmd -> AimModeCmd -> Bool
$c== :: AimModeCmd -> AimModeCmd -> Bool
Eq, Eq AimModeCmd
Eq AimModeCmd =>
(AimModeCmd -> AimModeCmd -> Ordering)
-> (AimModeCmd -> AimModeCmd -> Bool)
-> (AimModeCmd -> AimModeCmd -> Bool)
-> (AimModeCmd -> AimModeCmd -> Bool)
-> (AimModeCmd -> AimModeCmd -> Bool)
-> (AimModeCmd -> AimModeCmd -> AimModeCmd)
-> (AimModeCmd -> AimModeCmd -> AimModeCmd)
-> Ord AimModeCmd
AimModeCmd -> AimModeCmd -> Bool
AimModeCmd -> AimModeCmd -> Ordering
AimModeCmd -> AimModeCmd -> AimModeCmd
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 :: AimModeCmd -> AimModeCmd -> AimModeCmd
$cmin :: AimModeCmd -> AimModeCmd -> AimModeCmd
max :: AimModeCmd -> AimModeCmd -> AimModeCmd
$cmax :: AimModeCmd -> AimModeCmd -> AimModeCmd
>= :: AimModeCmd -> AimModeCmd -> Bool
$c>= :: AimModeCmd -> AimModeCmd -> Bool
> :: AimModeCmd -> AimModeCmd -> Bool
$c> :: AimModeCmd -> AimModeCmd -> Bool
<= :: AimModeCmd -> AimModeCmd -> Bool
$c<= :: AimModeCmd -> AimModeCmd -> Bool
< :: AimModeCmd -> AimModeCmd -> Bool
$c< :: AimModeCmd -> AimModeCmd -> Bool
compare :: AimModeCmd -> AimModeCmd -> Ordering
$ccompare :: AimModeCmd -> AimModeCmd -> Ordering
$cp1Ord :: Eq AimModeCmd
Ord, (forall x. AimModeCmd -> Rep AimModeCmd x)
-> (forall x. Rep AimModeCmd x -> AimModeCmd) -> Generic AimModeCmd
forall x. Rep AimModeCmd x -> AimModeCmd
forall x. AimModeCmd -> Rep AimModeCmd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AimModeCmd x -> AimModeCmd
$cfrom :: forall x. AimModeCmd -> Rep AimModeCmd x
Generic)

instance NFData AimModeCmd

instance Binary AimModeCmd

-- | Abstract syntax of human player commands.
data HumanCmd =
    -- Meta.
    Macro [String]
  | ByArea [(CmdArea, HumanCmd)]  -- if outside the areas, do nothing
  | ByAimMode AimModeCmd
  | ComposeIfLocal HumanCmd HumanCmd
  | ComposeUnlessError HumanCmd HumanCmd
  | Compose2ndLocal HumanCmd HumanCmd
  | LoopOnNothing HumanCmd
  | ExecuteIfClear HumanCmd
    -- Global.
    -- These usually take time.
  | Wait
  | Wait10
  | Yell
  | MoveDir Vector
  | RunDir Vector
  | RunOnceAhead
  | MoveOnceToXhair
  | RunOnceToXhair
  | ContinueToXhair
  | MoveItem [CStore] CStore (Maybe Text) Bool
  | Project
  | Apply
  | AlterDir
  | AlterWithPointer
  | CloseDir
  | Help
  | Hint
  | ItemMenu
  | MainMenu
  | MainMenuAutoOn
  | MainMenuAutoOff
  | Dashboard
    -- Below this line, commands do not take time.
  | GameTutorialToggle
  | GameDifficultyIncr
  | GameFishToggle
  | GameGoodsToggle
  | GameWolfToggle
  | GameKeeperToggle
  | GameScenarioIncr
  | GameRestart
  | GameQuit
  | GameDrop
  | GameExit
  | GameSave
  | Doctrine
  | Automate
  | AutomateToggle
  | AutomateBack
    -- Local. Below this line, commands do not notify the server.
  | ChooseItem ItemDialogMode
  | ChooseItemMenu ItemDialogMode
  | ChooseItemProject [TriggerItem]
  | ChooseItemApply [TriggerItem]
  | PickLeader Int
  | PickLeaderWithPointer
  | MemberCycle Direction
  | MemberCycleLevel Direction
  | SelectActor
  | SelectNone
  | SelectWithPointer
  | Repeat Int
  | RepeatLast Int
  | Record
  | AllHistory
  | LastHistory
  | MarkVision
  | MarkSmell
  | MarkSuspect
  | MarkAnim
  | OverrideTut
  | SettingsMenu
  | ChallengeMenu
  | PrintScreen
    -- These are mostly related to aiming.
  | Cancel
  | Accept
  | DetailCycle
  | ClearTargetIfItemClear
  | ItemClear
  | MoveXhair Vector Int
  | AimTgt
  | AimFloor
  | AimEnemy
  | AimItem
  | AimAscend Int
  | EpsIncr Direction
  | XhairUnknown
  | XhairItem
  | XhairStair Bool
  | XhairPointerFloor
  | XhairPointerMute
  | XhairPointerEnemy
  | AimPointerFloor
  | AimPointerEnemy
  deriving (Int -> HumanCmd -> ShowS
[HumanCmd] -> ShowS
HumanCmd -> String
(Int -> HumanCmd -> ShowS)
-> (HumanCmd -> String) -> ([HumanCmd] -> ShowS) -> Show HumanCmd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HumanCmd] -> ShowS
$cshowList :: [HumanCmd] -> ShowS
show :: HumanCmd -> String
$cshow :: HumanCmd -> String
showsPrec :: Int -> HumanCmd -> ShowS
$cshowsPrec :: Int -> HumanCmd -> ShowS
Show, ReadPrec [HumanCmd]
ReadPrec HumanCmd
Int -> ReadS HumanCmd
ReadS [HumanCmd]
(Int -> ReadS HumanCmd)
-> ReadS [HumanCmd]
-> ReadPrec HumanCmd
-> ReadPrec [HumanCmd]
-> Read HumanCmd
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HumanCmd]
$creadListPrec :: ReadPrec [HumanCmd]
readPrec :: ReadPrec HumanCmd
$creadPrec :: ReadPrec HumanCmd
readList :: ReadS [HumanCmd]
$creadList :: ReadS [HumanCmd]
readsPrec :: Int -> ReadS HumanCmd
$creadsPrec :: Int -> ReadS HumanCmd
Read, HumanCmd -> HumanCmd -> Bool
(HumanCmd -> HumanCmd -> Bool)
-> (HumanCmd -> HumanCmd -> Bool) -> Eq HumanCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HumanCmd -> HumanCmd -> Bool
$c/= :: HumanCmd -> HumanCmd -> Bool
== :: HumanCmd -> HumanCmd -> Bool
$c== :: HumanCmd -> HumanCmd -> Bool
Eq, Eq HumanCmd
Eq HumanCmd =>
(HumanCmd -> HumanCmd -> Ordering)
-> (HumanCmd -> HumanCmd -> Bool)
-> (HumanCmd -> HumanCmd -> Bool)
-> (HumanCmd -> HumanCmd -> Bool)
-> (HumanCmd -> HumanCmd -> Bool)
-> (HumanCmd -> HumanCmd -> HumanCmd)
-> (HumanCmd -> HumanCmd -> HumanCmd)
-> Ord HumanCmd
HumanCmd -> HumanCmd -> Bool
HumanCmd -> HumanCmd -> Ordering
HumanCmd -> HumanCmd -> HumanCmd
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 :: HumanCmd -> HumanCmd -> HumanCmd
$cmin :: HumanCmd -> HumanCmd -> HumanCmd
max :: HumanCmd -> HumanCmd -> HumanCmd
$cmax :: HumanCmd -> HumanCmd -> HumanCmd
>= :: HumanCmd -> HumanCmd -> Bool
$c>= :: HumanCmd -> HumanCmd -> Bool
> :: HumanCmd -> HumanCmd -> Bool
$c> :: HumanCmd -> HumanCmd -> Bool
<= :: HumanCmd -> HumanCmd -> Bool
$c<= :: HumanCmd -> HumanCmd -> Bool
< :: HumanCmd -> HumanCmd -> Bool
$c< :: HumanCmd -> HumanCmd -> Bool
compare :: HumanCmd -> HumanCmd -> Ordering
$ccompare :: HumanCmd -> HumanCmd -> Ordering
$cp1Ord :: Eq HumanCmd
Ord, (forall x. HumanCmd -> Rep HumanCmd x)
-> (forall x. Rep HumanCmd x -> HumanCmd) -> Generic HumanCmd
forall x. Rep HumanCmd x -> HumanCmd
forall x. HumanCmd -> Rep HumanCmd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HumanCmd x -> HumanCmd
$cfrom :: forall x. HumanCmd -> Rep HumanCmd x
Generic)

instance NFData HumanCmd

instance Binary HumanCmd

-- | Description of how item manipulation is triggered and communicated
-- to the player.
data TriggerItem =
  TriggerItem {TriggerItem -> Part
tiverb :: MU.Part, TriggerItem -> Part
tiobject :: MU.Part, TriggerItem -> String
tisymbols :: [Char]}
  deriving (Int -> TriggerItem -> ShowS
[TriggerItem] -> ShowS
TriggerItem -> String
(Int -> TriggerItem -> ShowS)
-> (TriggerItem -> String)
-> ([TriggerItem] -> ShowS)
-> Show TriggerItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TriggerItem] -> ShowS
$cshowList :: [TriggerItem] -> ShowS
show :: TriggerItem -> String
$cshow :: TriggerItem -> String
showsPrec :: Int -> TriggerItem -> ShowS
$cshowsPrec :: Int -> TriggerItem -> ShowS
Show, TriggerItem -> TriggerItem -> Bool
(TriggerItem -> TriggerItem -> Bool)
-> (TriggerItem -> TriggerItem -> Bool) -> Eq TriggerItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TriggerItem -> TriggerItem -> Bool
$c/= :: TriggerItem -> TriggerItem -> Bool
== :: TriggerItem -> TriggerItem -> Bool
$c== :: TriggerItem -> TriggerItem -> Bool
Eq, Eq TriggerItem
Eq TriggerItem =>
(TriggerItem -> TriggerItem -> Ordering)
-> (TriggerItem -> TriggerItem -> Bool)
-> (TriggerItem -> TriggerItem -> Bool)
-> (TriggerItem -> TriggerItem -> Bool)
-> (TriggerItem -> TriggerItem -> Bool)
-> (TriggerItem -> TriggerItem -> TriggerItem)
-> (TriggerItem -> TriggerItem -> TriggerItem)
-> Ord TriggerItem
TriggerItem -> TriggerItem -> Bool
TriggerItem -> TriggerItem -> Ordering
TriggerItem -> TriggerItem -> TriggerItem
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 :: TriggerItem -> TriggerItem -> TriggerItem
$cmin :: TriggerItem -> TriggerItem -> TriggerItem
max :: TriggerItem -> TriggerItem -> TriggerItem
$cmax :: TriggerItem -> TriggerItem -> TriggerItem
>= :: TriggerItem -> TriggerItem -> Bool
$c>= :: TriggerItem -> TriggerItem -> Bool
> :: TriggerItem -> TriggerItem -> Bool
$c> :: TriggerItem -> TriggerItem -> Bool
<= :: TriggerItem -> TriggerItem -> Bool
$c<= :: TriggerItem -> TriggerItem -> Bool
< :: TriggerItem -> TriggerItem -> Bool
$c< :: TriggerItem -> TriggerItem -> Bool
compare :: TriggerItem -> TriggerItem -> Ordering
$ccompare :: TriggerItem -> TriggerItem -> Ordering
$cp1Ord :: Eq TriggerItem
Ord, (forall x. TriggerItem -> Rep TriggerItem x)
-> (forall x. Rep TriggerItem x -> TriggerItem)
-> Generic TriggerItem
forall x. Rep TriggerItem x -> TriggerItem
forall x. TriggerItem -> Rep TriggerItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TriggerItem x -> TriggerItem
$cfrom :: forall x. TriggerItem -> Rep TriggerItem x
Generic)

instance Read TriggerItem where
  readsPrec :: Int -> ReadS TriggerItem
readsPrec = String -> Int -> ReadS TriggerItem
forall a. HasCallStack => String -> a
error (String -> Int -> ReadS TriggerItem)
-> String -> Int -> ReadS TriggerItem
forall a b. (a -> b) -> a -> b
$ "parsing of TriggerItem not implemented" String -> () -> String
forall v. Show v => String -> v -> String
`showFailure` ()

instance NFData TriggerItem

instance Binary TriggerItem