{-# 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.Content.ItemKind (ItemKind)
import Game.LambdaHack.Definition.Defs

data CmdCategory =
    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
$cshowsPrec :: Int -> CmdCategory -> ShowS
showsPrec :: Int -> CmdCategory -> ShowS
$cshow :: CmdCategory -> String
show :: CmdCategory -> String
$cshowList :: [CmdCategory] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS CmdCategory
readsPrec :: Int -> ReadS CmdCategory
$creadList :: ReadS [CmdCategory]
readList :: ReadS [CmdCategory]
$creadPrec :: ReadPrec CmdCategory
readPrec :: ReadPrec CmdCategory
$creadListPrec :: ReadPrec [CmdCategory]
readListPrec :: ReadPrec [CmdCategory]
Read, CmdCategory -> CmdCategory -> Bool
(CmdCategory -> CmdCategory -> Bool)
-> (CmdCategory -> CmdCategory -> Bool) -> Eq CmdCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmdCategory -> CmdCategory -> Bool
== :: CmdCategory -> CmdCategory -> Bool
$c/= :: CmdCategory -> CmdCategory -> Bool
/= :: 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
$cfrom :: forall x. CmdCategory -> Rep CmdCategory x
from :: forall x. CmdCategory -> Rep CmdCategory x
$cto :: forall x. Rep CmdCategory x -> CmdCategory
to :: forall x. Rep CmdCategory x -> CmdCategory
Generic)

instance NFData CmdCategory

instance Binary CmdCategory

categoryDescription :: CmdCategory -> Text
categoryDescription :: CmdCategory -> Text
categoryDescription CmdCategory
CmdDashboard = Text
"Dashboard"
categoryDescription CmdCategory
CmdItemMenu = Text
"Item menu commands"
categoryDescription CmdCategory
CmdMove = Text
"Terrain exploration and modification commands"
categoryDescription CmdCategory
CmdItem = Text
"All item-related commands"
categoryDescription CmdCategory
CmdAim = Text
"All aiming commands"
categoryDescription CmdCategory
CmdMeta = Text
"Assorted commands"
categoryDescription CmdCategory
CmdMouse = Text
"Mouse"
categoryDescription CmdCategory
CmdInternal = Text
"Internal"
categoryDescription CmdCategory
CmdDebug = Text
"Debug"
categoryDescription CmdCategory
CmdMinimal = Text
"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
$cshowsPrec :: Int -> CmdArea -> ShowS
showsPrec :: Int -> CmdArea -> ShowS
$cshow :: CmdArea -> String
show :: CmdArea -> String
$cshowList :: [CmdArea] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS CmdArea
readsPrec :: Int -> ReadS CmdArea
$creadList :: ReadS [CmdArea]
readList :: ReadS [CmdArea]
$creadPrec :: ReadPrec CmdArea
readPrec :: ReadPrec CmdArea
$creadListPrec :: ReadPrec [CmdArea]
readListPrec :: ReadPrec [CmdArea]
Read, CmdArea -> CmdArea -> Bool
(CmdArea -> CmdArea -> Bool)
-> (CmdArea -> CmdArea -> Bool) -> Eq CmdArea
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmdArea -> CmdArea -> Bool
== :: CmdArea -> CmdArea -> Bool
$c/= :: CmdArea -> CmdArea -> Bool
/= :: 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
$ccompare :: CmdArea -> CmdArea -> Ordering
compare :: CmdArea -> CmdArea -> Ordering
$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
>= :: CmdArea -> CmdArea -> Bool
$cmax :: CmdArea -> CmdArea -> CmdArea
max :: CmdArea -> CmdArea -> CmdArea
$cmin :: CmdArea -> CmdArea -> CmdArea
min :: CmdArea -> CmdArea -> 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
$cfrom :: forall x. CmdArea -> Rep CmdArea x
from :: forall x. CmdArea -> Rep CmdArea x
$cto :: forall x. Rep CmdArea x -> CmdArea
to :: forall x. Rep CmdArea x -> CmdArea
Generic)

instance NFData CmdArea

instance Binary CmdArea

areaDescription :: CmdArea -> Text
areaDescription :: CmdArea -> Text
areaDescription CmdArea
ca = case CmdArea
ca of
  CmdArea
CaMessage ->      Text
"message line"
  CmdArea
CaMapLeader ->    Text
"pointman tile"
  CmdArea
CaMapParty ->     Text
"party on map"
  CmdArea
CaMap ->          Text
"the map area"
  CmdArea
CaLevelNumber ->  Text
"level number"
  CmdArea
CaArenaName ->    Text
"level caption"
  CmdArea
CaPercentSeen ->  Text
"percent seen"
  CmdArea
CaXhairDesc ->    Text
"crosshair info"
  CmdArea
CaSelected ->     Text
"party roster"
  CmdArea
CaCalmGauge ->    Text
"Calm gauge"
  CmdArea
CaCalmValue ->    Text
"Calm value"
  CmdArea
CaHPGauge ->      Text
"HP gauge"
  CmdArea
CaHPValue ->      Text
"HP value"
  CmdArea
CaLeaderDesc ->   Text
"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
$cshowsPrec :: Int -> AimModeCmd -> ShowS
showsPrec :: Int -> AimModeCmd -> ShowS
$cshow :: AimModeCmd -> String
show :: AimModeCmd -> String
$cshowList :: [AimModeCmd] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS AimModeCmd
readsPrec :: Int -> ReadS AimModeCmd
$creadList :: ReadS [AimModeCmd]
readList :: ReadS [AimModeCmd]
$creadPrec :: ReadPrec AimModeCmd
readPrec :: ReadPrec AimModeCmd
$creadListPrec :: ReadPrec [AimModeCmd]
readListPrec :: ReadPrec [AimModeCmd]
Read, AimModeCmd -> AimModeCmd -> Bool
(AimModeCmd -> AimModeCmd -> Bool)
-> (AimModeCmd -> AimModeCmd -> Bool) -> Eq AimModeCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AimModeCmd -> AimModeCmd -> Bool
== :: AimModeCmd -> AimModeCmd -> Bool
$c/= :: AimModeCmd -> AimModeCmd -> Bool
/= :: 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
$ccompare :: AimModeCmd -> AimModeCmd -> Ordering
compare :: AimModeCmd -> AimModeCmd -> Ordering
$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
>= :: AimModeCmd -> AimModeCmd -> Bool
$cmax :: AimModeCmd -> AimModeCmd -> AimModeCmd
max :: AimModeCmd -> AimModeCmd -> AimModeCmd
$cmin :: AimModeCmd -> AimModeCmd -> AimModeCmd
min :: AimModeCmd -> AimModeCmd -> 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
$cfrom :: forall x. AimModeCmd -> Rep AimModeCmd x
from :: forall x. AimModeCmd -> Rep AimModeCmd x
$cto :: forall x. Rep AimModeCmd x -> AimModeCmd
to :: forall x. Rep AimModeCmd x -> AimModeCmd
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.
  | GameDifficultyIncr Int
  | GameFishToggle
  | GameGoodsToggle
  | GameWolfToggle
  | GameKeeperToggle
  | GameScenarioIncr Int
  | 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
  | PointmanCycle Direction
  | PointmanCycleLevel Direction
  | SelectActor
  | SelectNone
  | SelectWithPointer
  | Repeat Int
  | RepeatLast Int
  | Record
  | AllHistory
  | MarkVision Int
  | MarkSmell
  | MarkSuspect Int
  | MarkAnim
  | OverrideTut Int
  | 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
$cshowsPrec :: Int -> HumanCmd -> ShowS
showsPrec :: Int -> HumanCmd -> ShowS
$cshow :: HumanCmd -> String
show :: HumanCmd -> String
$cshowList :: [HumanCmd] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS HumanCmd
readsPrec :: Int -> ReadS HumanCmd
$creadList :: ReadS [HumanCmd]
readList :: ReadS [HumanCmd]
$creadPrec :: ReadPrec HumanCmd
readPrec :: ReadPrec HumanCmd
$creadListPrec :: ReadPrec [HumanCmd]
readListPrec :: ReadPrec [HumanCmd]
Read, HumanCmd -> HumanCmd -> Bool
(HumanCmd -> HumanCmd -> Bool)
-> (HumanCmd -> HumanCmd -> Bool) -> Eq HumanCmd
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HumanCmd -> HumanCmd -> Bool
== :: HumanCmd -> HumanCmd -> Bool
$c/= :: HumanCmd -> HumanCmd -> Bool
/= :: 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
$ccompare :: HumanCmd -> HumanCmd -> Ordering
compare :: HumanCmd -> HumanCmd -> Ordering
$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
>= :: HumanCmd -> HumanCmd -> Bool
$cmax :: HumanCmd -> HumanCmd -> HumanCmd
max :: HumanCmd -> HumanCmd -> HumanCmd
$cmin :: HumanCmd -> HumanCmd -> HumanCmd
min :: HumanCmd -> HumanCmd -> 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
$cfrom :: forall x. HumanCmd -> Rep HumanCmd x
from :: forall x. HumanCmd -> Rep HumanCmd x
$cto :: forall x. Rep HumanCmd x -> HumanCmd
to :: forall x. Rep HumanCmd x -> HumanCmd
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 :: [ContentSymbol ItemKind]}
  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
$cshowsPrec :: Int -> TriggerItem -> ShowS
showsPrec :: Int -> TriggerItem -> ShowS
$cshow :: TriggerItem -> String
show :: TriggerItem -> String
$cshowList :: [TriggerItem] -> ShowS
showList :: [TriggerItem] -> ShowS
Show, TriggerItem -> TriggerItem -> Bool
(TriggerItem -> TriggerItem -> Bool)
-> (TriggerItem -> TriggerItem -> Bool) -> Eq TriggerItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TriggerItem -> TriggerItem -> Bool
== :: TriggerItem -> TriggerItem -> Bool
$c/= :: TriggerItem -> TriggerItem -> Bool
/= :: 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
$ccompare :: TriggerItem -> TriggerItem -> Ordering
compare :: TriggerItem -> TriggerItem -> Ordering
$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
>= :: TriggerItem -> TriggerItem -> Bool
$cmax :: TriggerItem -> TriggerItem -> TriggerItem
max :: TriggerItem -> TriggerItem -> TriggerItem
$cmin :: TriggerItem -> TriggerItem -> TriggerItem
min :: TriggerItem -> TriggerItem -> 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
$cfrom :: forall x. TriggerItem -> Rep TriggerItem x
from :: forall x. TriggerItem -> Rep TriggerItem x
$cto :: forall x. Rep TriggerItem x -> TriggerItem
to :: forall x. Rep TriggerItem x -> TriggerItem
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
$ String
"parsing of TriggerItem not implemented" String -> () -> String
forall v. Show v => String -> v -> String
`showFailure` ()

instance NFData TriggerItem

instance Binary TriggerItem