{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Very basic types for content definitions with their internals exposed.
module Game.LambdaHack.Definition.DefsInternal
  ( GroupName(..), displayGroupName
  , ContentId, toContentId, fromContentId, contentIdIndex
  , ContentSymbol, toContentSymbol, displayContentSymbol
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Control.DeepSeq
import Data.Binary
import Data.Hashable

-- If ever needed, we can use a symbol table here, since content
-- is never serialized. But we'd need to cover the few cases
-- (e.g., @litemFreq@) where @GroupName@ goes into savegame.
newtype GroupName c = GroupName {GroupName c -> Text
fromGroupName :: Text}
  deriving (Int -> GroupName c -> ShowS
[GroupName c] -> ShowS
GroupName c -> String
(Int -> GroupName c -> ShowS)
-> (GroupName c -> String)
-> ([GroupName c] -> ShowS)
-> Show (GroupName c)
forall c. Int -> GroupName c -> ShowS
forall c. [GroupName c] -> ShowS
forall c. GroupName c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupName c] -> ShowS
$cshowList :: forall c. [GroupName c] -> ShowS
show :: GroupName c -> String
$cshow :: forall c. GroupName c -> String
showsPrec :: Int -> GroupName c -> ShowS
$cshowsPrec :: forall c. Int -> GroupName c -> ShowS
Show, GroupName c -> GroupName c -> Bool
(GroupName c -> GroupName c -> Bool)
-> (GroupName c -> GroupName c -> Bool) -> Eq (GroupName c)
forall c. GroupName c -> GroupName c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupName c -> GroupName c -> Bool
$c/= :: forall c. GroupName c -> GroupName c -> Bool
== :: GroupName c -> GroupName c -> Bool
$c== :: forall c. GroupName c -> GroupName c -> Bool
Eq, Eq (GroupName c)
Eq (GroupName c)
-> (GroupName c -> GroupName c -> Ordering)
-> (GroupName c -> GroupName c -> Bool)
-> (GroupName c -> GroupName c -> Bool)
-> (GroupName c -> GroupName c -> Bool)
-> (GroupName c -> GroupName c -> Bool)
-> (GroupName c -> GroupName c -> GroupName c)
-> (GroupName c -> GroupName c -> GroupName c)
-> Ord (GroupName c)
GroupName c -> GroupName c -> Bool
GroupName c -> GroupName c -> Ordering
GroupName c -> GroupName c -> GroupName c
forall c. Eq (GroupName c)
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
forall c. GroupName c -> GroupName c -> Bool
forall c. GroupName c -> GroupName c -> Ordering
forall c. GroupName c -> GroupName c -> GroupName c
min :: GroupName c -> GroupName c -> GroupName c
$cmin :: forall c. GroupName c -> GroupName c -> GroupName c
max :: GroupName c -> GroupName c -> GroupName c
$cmax :: forall c. GroupName c -> GroupName c -> GroupName c
>= :: GroupName c -> GroupName c -> Bool
$c>= :: forall c. GroupName c -> GroupName c -> Bool
> :: GroupName c -> GroupName c -> Bool
$c> :: forall c. GroupName c -> GroupName c -> Bool
<= :: GroupName c -> GroupName c -> Bool
$c<= :: forall c. GroupName c -> GroupName c -> Bool
< :: GroupName c -> GroupName c -> Bool
$c< :: forall c. GroupName c -> GroupName c -> Bool
compare :: GroupName c -> GroupName c -> Ordering
$ccompare :: forall c. GroupName c -> GroupName c -> Ordering
$cp1Ord :: forall c. Eq (GroupName c)
Ord, Eq (GroupName c)
Eq (GroupName c)
-> (Int -> GroupName c -> Int)
-> (GroupName c -> Int)
-> Hashable (GroupName c)
Int -> GroupName c -> Int
GroupName c -> Int
forall c. Eq (GroupName c)
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall c. Int -> GroupName c -> Int
forall c. GroupName c -> Int
hash :: GroupName c -> Int
$chash :: forall c. GroupName c -> Int
hashWithSalt :: Int -> GroupName c -> Int
$chashWithSalt :: forall c. Int -> GroupName c -> Int
$cp1Hashable :: forall c. Eq (GroupName c)
Hashable, Get (GroupName c)
[GroupName c] -> Put
GroupName c -> Put
(GroupName c -> Put)
-> Get (GroupName c)
-> ([GroupName c] -> Put)
-> Binary (GroupName c)
forall c. Get (GroupName c)
forall c. [GroupName c] -> Put
forall c. GroupName c -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GroupName c] -> Put
$cputList :: forall c. [GroupName c] -> Put
get :: Get (GroupName c)
$cget :: forall c. Get (GroupName c)
put :: GroupName c -> Put
$cput :: forall c. GroupName c -> Put
Binary, GroupName c -> ()
(GroupName c -> ()) -> NFData (GroupName c)
forall c. GroupName c -> ()
forall a. (a -> ()) -> NFData a
rnf :: GroupName c -> ()
$crnf :: forall c. GroupName c -> ()
NFData)

-- | This does not need to be 1-1, so should not be used in place of the
-- 'Eq' instance, etc.
displayGroupName :: GroupName c -> Text
displayGroupName :: GroupName c -> Text
displayGroupName = GroupName c -> Text
forall c. GroupName c -> Text
fromGroupName

-- | Content identifiers for the content type @c@.
newtype ContentId c = ContentId Word16
  deriving (Int -> ContentId c -> ShowS
[ContentId c] -> ShowS
ContentId c -> String
(Int -> ContentId c -> ShowS)
-> (ContentId c -> String)
-> ([ContentId c] -> ShowS)
-> Show (ContentId c)
forall c. Int -> ContentId c -> ShowS
forall c. [ContentId c] -> ShowS
forall c. ContentId c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentId c] -> ShowS
$cshowList :: forall c. [ContentId c] -> ShowS
show :: ContentId c -> String
$cshow :: forall c. ContentId c -> String
showsPrec :: Int -> ContentId c -> ShowS
$cshowsPrec :: forall c. Int -> ContentId c -> ShowS
Show, ContentId c -> ContentId c -> Bool
(ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool) -> Eq (ContentId c)
forall c. ContentId c -> ContentId c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentId c -> ContentId c -> Bool
$c/= :: forall c. ContentId c -> ContentId c -> Bool
== :: ContentId c -> ContentId c -> Bool
$c== :: forall c. ContentId c -> ContentId c -> Bool
Eq, Eq (ContentId c)
Eq (ContentId c)
-> (ContentId c -> ContentId c -> Ordering)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> ContentId c)
-> (ContentId c -> ContentId c -> ContentId c)
-> Ord (ContentId c)
ContentId c -> ContentId c -> Bool
ContentId c -> ContentId c -> Ordering
ContentId c -> ContentId c -> ContentId c
forall c. Eq (ContentId c)
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
forall c. ContentId c -> ContentId c -> Bool
forall c. ContentId c -> ContentId c -> Ordering
forall c. ContentId c -> ContentId c -> ContentId c
min :: ContentId c -> ContentId c -> ContentId c
$cmin :: forall c. ContentId c -> ContentId c -> ContentId c
max :: ContentId c -> ContentId c -> ContentId c
$cmax :: forall c. ContentId c -> ContentId c -> ContentId c
>= :: ContentId c -> ContentId c -> Bool
$c>= :: forall c. ContentId c -> ContentId c -> Bool
> :: ContentId c -> ContentId c -> Bool
$c> :: forall c. ContentId c -> ContentId c -> Bool
<= :: ContentId c -> ContentId c -> Bool
$c<= :: forall c. ContentId c -> ContentId c -> Bool
< :: ContentId c -> ContentId c -> Bool
$c< :: forall c. ContentId c -> ContentId c -> Bool
compare :: ContentId c -> ContentId c -> Ordering
$ccompare :: forall c. ContentId c -> ContentId c -> Ordering
$cp1Ord :: forall c. Eq (ContentId c)
Ord, Int -> ContentId c
ContentId c -> Int
ContentId c -> [ContentId c]
ContentId c -> ContentId c
ContentId c -> ContentId c -> [ContentId c]
ContentId c -> ContentId c -> ContentId c -> [ContentId c]
(ContentId c -> ContentId c)
-> (ContentId c -> ContentId c)
-> (Int -> ContentId c)
-> (ContentId c -> Int)
-> (ContentId c -> [ContentId c])
-> (ContentId c -> ContentId c -> [ContentId c])
-> (ContentId c -> ContentId c -> [ContentId c])
-> (ContentId c -> ContentId c -> ContentId c -> [ContentId c])
-> Enum (ContentId c)
forall c. Int -> ContentId c
forall c. ContentId c -> Int
forall c. ContentId c -> [ContentId c]
forall c. ContentId c -> ContentId c
forall c. ContentId c -> ContentId c -> [ContentId c]
forall c.
ContentId c -> ContentId c -> ContentId c -> [ContentId c]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ContentId c -> ContentId c -> ContentId c -> [ContentId c]
$cenumFromThenTo :: forall c.
ContentId c -> ContentId c -> ContentId c -> [ContentId c]
enumFromTo :: ContentId c -> ContentId c -> [ContentId c]
$cenumFromTo :: forall c. ContentId c -> ContentId c -> [ContentId c]
enumFromThen :: ContentId c -> ContentId c -> [ContentId c]
$cenumFromThen :: forall c. ContentId c -> ContentId c -> [ContentId c]
enumFrom :: ContentId c -> [ContentId c]
$cenumFrom :: forall c. ContentId c -> [ContentId c]
fromEnum :: ContentId c -> Int
$cfromEnum :: forall c. ContentId c -> Int
toEnum :: Int -> ContentId c
$ctoEnum :: forall c. Int -> ContentId c
pred :: ContentId c -> ContentId c
$cpred :: forall c. ContentId c -> ContentId c
succ :: ContentId c -> ContentId c
$csucc :: forall c. ContentId c -> ContentId c
Enum, Eq (ContentId c)
Eq (ContentId c)
-> (Int -> ContentId c -> Int)
-> (ContentId c -> Int)
-> Hashable (ContentId c)
Int -> ContentId c -> Int
ContentId c -> Int
forall c. Eq (ContentId c)
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall c. Int -> ContentId c -> Int
forall c. ContentId c -> Int
hash :: ContentId c -> Int
$chash :: forall c. ContentId c -> Int
hashWithSalt :: Int -> ContentId c -> Int
$chashWithSalt :: forall c. Int -> ContentId c -> Int
$cp1Hashable :: forall c. Eq (ContentId c)
Hashable, Get (ContentId c)
[ContentId c] -> Put
ContentId c -> Put
(ContentId c -> Put)
-> Get (ContentId c)
-> ([ContentId c] -> Put)
-> Binary (ContentId c)
forall c. Get (ContentId c)
forall c. [ContentId c] -> Put
forall c. ContentId c -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ContentId c] -> Put
$cputList :: forall c. [ContentId c] -> Put
get :: Get (ContentId c)
$cget :: forall c. Get (ContentId c)
put :: ContentId c -> Put
$cput :: forall c. ContentId c -> Put
Binary)

toContentId :: Word16 -> ContentId c
{-# INLINE toContentId #-}
toContentId :: Word16 -> ContentId c
toContentId = Word16 -> ContentId c
forall c. Word16 -> ContentId c
ContentId

fromContentId :: ContentId c -> Word16
{-# INLINE fromContentId #-}
fromContentId :: ContentId c -> Word16
fromContentId (ContentId Word16
k) = Word16
k

contentIdIndex :: ContentId c -> Int
{-# INLINE contentIdIndex #-}
contentIdIndex :: ContentId c -> Int
contentIdIndex (ContentId Word16
k) = Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
k

-- TODO: temporary, not to break compilation too soon:
--{--
type ContentSymbol c = Char
toContentSymbol :: Char -> ContentSymbol c
toContentSymbol :: Char -> Char
toContentSymbol = Char -> Char
forall a. a -> a
id
displayContentSymbol :: ContentSymbol c -> Char
displayContentSymbol :: Char -> Char
displayContentSymbol = Char -> Char
forall a. a -> a
id
--}

-- TODO: The intended definitions. Error they are going to cause will
-- point out all the remaining item symbols hardwired in the engine
-- and make any future accidental hardwiring harder.
-- TODO2: extend to other content kinds than item kinds.
{-
-- | An abstract view on the symbol of a content item definition.
-- Hiding the constructor prevents hardwiring symbols inside the engine
-- by accident (this is still possible via conversion functions,
-- if one insists, so the abstraction is leaky, but that's fine).
newtype ContentSymbol c = ContentSymbol Char
  deriving (Show, Eq, Ord, Binary, NFData)  -- TODO: Generic and most others are only needed for TriggerItem, so once the latter is removed, these instances can go.

-- | This is a 1-1 inclusion. Don't use, if an equal named symbol already
-- exists in rules content.
toContentSymbol :: Char -> ContentSymbol c
{-# INLINE toContentSymbol #-}
toContentSymbol = ContentSymbol

-- | This does not need to be 1-1, so should not be used in place of the
-- 'Eq' instance, etc.
displayContentSymbol :: ContentSymbol c -> Char
{-# INLINE displayContentSymbol #-}
displayContentSymbol (ContentSymbol c) = c
--}