{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE ViewPatterns          #-}

module LDtk.Types where

import Data.Aeson
import GHC.Generics
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word8)
import Data.Maybe (listToMaybe)
import Numeric (readHex)
import Data.Aeson.Types (Parser)

ldtkOpts :: Options
ldtkOpts :: Options
ldtkOpts = Options
defaultOptions
  { fieldLabelModifier :: String -> String
fieldLabelModifier = \case
      -- Names that are too atrocious to allow
      String
"data'"     -> String
"data"
      String
"enumid"    -> String
"id"
      String
"tile_flip" -> String
"f"
      String
x           -> String
x
  , allNullaryToStringTag :: Bool
allNullaryToStringTag = Bool
True
  , unwrapUnaryRecords :: Bool
unwrapUnaryRecords = Bool
True
  }

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

instance FromJSON Color where
  parseJSON :: Value -> Parser Color
parseJSON Value
v = do
    (Char
'#' : Char
r1 : Char
r2 : Char
g1 : Char
g2 : Char
b1 : Char
b2 : []) <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    let safe_read :: [(a, b)] -> Parser (Maybe a)
safe_read = Maybe a -> Parser (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Parser (Maybe a))
-> ([(a, b)] -> Maybe a) -> [(a, b)] -> Parser (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> ([(a, b)] -> [a]) -> [(a, b)] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> [(a, b)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst
    Just Word8
r <- [(Word8, String)] -> Parser (Maybe Word8)
forall a b. [(a, b)] -> Parser (Maybe a)
safe_read ([(Word8, String)] -> Parser (Maybe Word8))
-> [(Word8, String)] -> Parser (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ ReadS Word8
forall a. (Eq a, Num a) => ReadS a
readHex [Char
r1, Char
r2]
    Just Word8
g <- [(Word8, String)] -> Parser (Maybe Word8)
forall a b. [(a, b)] -> Parser (Maybe a)
safe_read ([(Word8, String)] -> Parser (Maybe Word8))
-> [(Word8, String)] -> Parser (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ ReadS Word8
forall a. (Eq a, Num a) => ReadS a
readHex [Char
g1, Char
g2]
    Just Word8
b <- [(Word8, String)] -> Parser (Maybe Word8)
forall a b. [(a, b)] -> Parser (Maybe a)
safe_read ([(Word8, String)] -> Parser (Maybe Word8))
-> [(Word8, String)] -> Parser (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ ReadS Word8
forall a. (Eq a, Num a) => ReadS a
readHex [Char
b1, Char
b2]
    Color -> Parser Color
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Color -> Parser Color) -> Color -> Parser Color
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Color
Color Word8
r Word8
g Word8
b


data EntityDef = EntityDef
  { EntityDef -> Color
color :: Color
  , EntityDef -> Int
height :: Int
  , EntityDef -> Text
identifier :: Text
  , EntityDef -> [Int]
nineSliceBorders :: [Int]
  , EntityDef -> Float
pivotX :: Float
  , EntityDef -> Float
pivotY :: Float
  , EntityDef -> Maybe TilesetRect
tileRect :: Maybe TilesetRect
  , EntityDef -> TileRenderMode
tileRenderMode :: TileRenderMode
  , EntityDef -> Maybe Int
tilesetId :: Maybe Int
  , EntityDef -> Int
uid :: Int
  , EntityDef -> Int
width :: Int
  }
  deriving stock (EntityDef -> EntityDef -> Bool
(EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool) -> Eq EntityDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDef -> EntityDef -> Bool
$c/= :: EntityDef -> EntityDef -> Bool
== :: EntityDef -> EntityDef -> Bool
$c== :: EntityDef -> EntityDef -> Bool
Eq, Eq EntityDef
Eq EntityDef
-> (EntityDef -> EntityDef -> Ordering)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> EntityDef)
-> (EntityDef -> EntityDef -> EntityDef)
-> Ord EntityDef
EntityDef -> EntityDef -> Bool
EntityDef -> EntityDef -> Ordering
EntityDef -> EntityDef -> EntityDef
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 :: EntityDef -> EntityDef -> EntityDef
$cmin :: EntityDef -> EntityDef -> EntityDef
max :: EntityDef -> EntityDef -> EntityDef
$cmax :: EntityDef -> EntityDef -> EntityDef
>= :: EntityDef -> EntityDef -> Bool
$c>= :: EntityDef -> EntityDef -> Bool
> :: EntityDef -> EntityDef -> Bool
$c> :: EntityDef -> EntityDef -> Bool
<= :: EntityDef -> EntityDef -> Bool
$c<= :: EntityDef -> EntityDef -> Bool
< :: EntityDef -> EntityDef -> Bool
$c< :: EntityDef -> EntityDef -> Bool
compare :: EntityDef -> EntityDef -> Ordering
$ccompare :: EntityDef -> EntityDef -> Ordering
$cp1Ord :: Eq EntityDef
Ord, Int -> EntityDef -> String -> String
[EntityDef] -> String -> String
EntityDef -> String
(Int -> EntityDef -> String -> String)
-> (EntityDef -> String)
-> ([EntityDef] -> String -> String)
-> Show EntityDef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EntityDef] -> String -> String
$cshowList :: [EntityDef] -> String -> String
show :: EntityDef -> String
$cshow :: EntityDef -> String
showsPrec :: Int -> EntityDef -> String -> String
$cshowsPrec :: Int -> EntityDef -> String -> String
Show, ReadPrec [EntityDef]
ReadPrec EntityDef
Int -> ReadS EntityDef
ReadS [EntityDef]
(Int -> ReadS EntityDef)
-> ReadS [EntityDef]
-> ReadPrec EntityDef
-> ReadPrec [EntityDef]
-> Read EntityDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityDef]
$creadListPrec :: ReadPrec [EntityDef]
readPrec :: ReadPrec EntityDef
$creadPrec :: ReadPrec EntityDef
readList :: ReadS [EntityDef]
$creadList :: ReadS [EntityDef]
readsPrec :: Int -> ReadS EntityDef
$creadsPrec :: Int -> ReadS EntityDef
Read, (forall x. EntityDef -> Rep EntityDef x)
-> (forall x. Rep EntityDef x -> EntityDef) -> Generic EntityDef
forall x. Rep EntityDef x -> EntityDef
forall x. EntityDef -> Rep EntityDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EntityDef x -> EntityDef
$cfrom :: forall x. EntityDef -> Rep EntityDef x
Generic)

data EmbedAtlas = LdtkIcons
  deriving stock (EmbedAtlas -> EmbedAtlas -> Bool
(EmbedAtlas -> EmbedAtlas -> Bool)
-> (EmbedAtlas -> EmbedAtlas -> Bool) -> Eq EmbedAtlas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbedAtlas -> EmbedAtlas -> Bool
$c/= :: EmbedAtlas -> EmbedAtlas -> Bool
== :: EmbedAtlas -> EmbedAtlas -> Bool
$c== :: EmbedAtlas -> EmbedAtlas -> Bool
Eq, Eq EmbedAtlas
Eq EmbedAtlas
-> (EmbedAtlas -> EmbedAtlas -> Ordering)
-> (EmbedAtlas -> EmbedAtlas -> Bool)
-> (EmbedAtlas -> EmbedAtlas -> Bool)
-> (EmbedAtlas -> EmbedAtlas -> Bool)
-> (EmbedAtlas -> EmbedAtlas -> Bool)
-> (EmbedAtlas -> EmbedAtlas -> EmbedAtlas)
-> (EmbedAtlas -> EmbedAtlas -> EmbedAtlas)
-> Ord EmbedAtlas
EmbedAtlas -> EmbedAtlas -> Bool
EmbedAtlas -> EmbedAtlas -> Ordering
EmbedAtlas -> EmbedAtlas -> EmbedAtlas
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 :: EmbedAtlas -> EmbedAtlas -> EmbedAtlas
$cmin :: EmbedAtlas -> EmbedAtlas -> EmbedAtlas
max :: EmbedAtlas -> EmbedAtlas -> EmbedAtlas
$cmax :: EmbedAtlas -> EmbedAtlas -> EmbedAtlas
>= :: EmbedAtlas -> EmbedAtlas -> Bool
$c>= :: EmbedAtlas -> EmbedAtlas -> Bool
> :: EmbedAtlas -> EmbedAtlas -> Bool
$c> :: EmbedAtlas -> EmbedAtlas -> Bool
<= :: EmbedAtlas -> EmbedAtlas -> Bool
$c<= :: EmbedAtlas -> EmbedAtlas -> Bool
< :: EmbedAtlas -> EmbedAtlas -> Bool
$c< :: EmbedAtlas -> EmbedAtlas -> Bool
compare :: EmbedAtlas -> EmbedAtlas -> Ordering
$ccompare :: EmbedAtlas -> EmbedAtlas -> Ordering
$cp1Ord :: Eq EmbedAtlas
Ord, Int -> EmbedAtlas -> String -> String
[EmbedAtlas] -> String -> String
EmbedAtlas -> String
(Int -> EmbedAtlas -> String -> String)
-> (EmbedAtlas -> String)
-> ([EmbedAtlas] -> String -> String)
-> Show EmbedAtlas
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EmbedAtlas] -> String -> String
$cshowList :: [EmbedAtlas] -> String -> String
show :: EmbedAtlas -> String
$cshow :: EmbedAtlas -> String
showsPrec :: Int -> EmbedAtlas -> String -> String
$cshowsPrec :: Int -> EmbedAtlas -> String -> String
Show, ReadPrec [EmbedAtlas]
ReadPrec EmbedAtlas
Int -> ReadS EmbedAtlas
ReadS [EmbedAtlas]
(Int -> ReadS EmbedAtlas)
-> ReadS [EmbedAtlas]
-> ReadPrec EmbedAtlas
-> ReadPrec [EmbedAtlas]
-> Read EmbedAtlas
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmbedAtlas]
$creadListPrec :: ReadPrec [EmbedAtlas]
readPrec :: ReadPrec EmbedAtlas
$creadPrec :: ReadPrec EmbedAtlas
readList :: ReadS [EmbedAtlas]
$creadList :: ReadS [EmbedAtlas]
readsPrec :: Int -> ReadS EmbedAtlas
$creadsPrec :: Int -> ReadS EmbedAtlas
Read, Int -> EmbedAtlas
EmbedAtlas -> Int
EmbedAtlas -> [EmbedAtlas]
EmbedAtlas -> EmbedAtlas
EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
EmbedAtlas -> EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
(EmbedAtlas -> EmbedAtlas)
-> (EmbedAtlas -> EmbedAtlas)
-> (Int -> EmbedAtlas)
-> (EmbedAtlas -> Int)
-> (EmbedAtlas -> [EmbedAtlas])
-> (EmbedAtlas -> EmbedAtlas -> [EmbedAtlas])
-> (EmbedAtlas -> EmbedAtlas -> [EmbedAtlas])
-> (EmbedAtlas -> EmbedAtlas -> EmbedAtlas -> [EmbedAtlas])
-> Enum EmbedAtlas
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 :: EmbedAtlas -> EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
$cenumFromThenTo :: EmbedAtlas -> EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
enumFromTo :: EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
$cenumFromTo :: EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
enumFromThen :: EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
$cenumFromThen :: EmbedAtlas -> EmbedAtlas -> [EmbedAtlas]
enumFrom :: EmbedAtlas -> [EmbedAtlas]
$cenumFrom :: EmbedAtlas -> [EmbedAtlas]
fromEnum :: EmbedAtlas -> Int
$cfromEnum :: EmbedAtlas -> Int
toEnum :: Int -> EmbedAtlas
$ctoEnum :: Int -> EmbedAtlas
pred :: EmbedAtlas -> EmbedAtlas
$cpred :: EmbedAtlas -> EmbedAtlas
succ :: EmbedAtlas -> EmbedAtlas
$csucc :: EmbedAtlas -> EmbedAtlas
Enum, EmbedAtlas
EmbedAtlas -> EmbedAtlas -> Bounded EmbedAtlas
forall a. a -> a -> Bounded a
maxBound :: EmbedAtlas
$cmaxBound :: EmbedAtlas
minBound :: EmbedAtlas
$cminBound :: EmbedAtlas
Bounded, (forall x. EmbedAtlas -> Rep EmbedAtlas x)
-> (forall x. Rep EmbedAtlas x -> EmbedAtlas) -> Generic EmbedAtlas
forall x. Rep EmbedAtlas x -> EmbedAtlas
forall x. EmbedAtlas -> Rep EmbedAtlas x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EmbedAtlas x -> EmbedAtlas
$cfrom :: forall x. EmbedAtlas -> Rep EmbedAtlas x
Generic)

instance FromJSON EmbedAtlas where
  parseJSON :: Value -> Parser EmbedAtlas
parseJSON Value
v = do
    String
"LdtkIcons" <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON @String Value
v
    EmbedAtlas -> Parser EmbedAtlas
forall (f :: * -> *) a. Applicative f => a -> f a
pure EmbedAtlas
LdtkIcons

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

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

data TilesetDef = TilesetDef
  { TilesetDef -> Int
__cHei :: Int
  , TilesetDef -> Int
__cWid :: Int
  , TilesetDef -> [CustomData]
customData :: [CustomData]
  , TilesetDef -> Maybe EmbedAtlas
embedAtlas :: Maybe EmbedAtlas
  , TilesetDef -> [EnumTag]
enumTags :: [EnumTag]
  , TilesetDef -> Text
identifier :: Text
  , TilesetDef -> Int
padding :: Int
  , TilesetDef -> Int
pxHei :: Int
  , TilesetDef -> Int
pxWid :: Int
  , TilesetDef -> Maybe String
relPath :: Maybe FilePath
  , TilesetDef -> Int
spacing :: Int
  , TilesetDef -> [Text]
tags :: [Text]
  , TilesetDef -> Maybe Int
tagsSourceEnumUid :: Maybe Int
  , TilesetDef -> Int
tileGridSize :: Int
  , TilesetDef -> Int
uid :: Int
  }
  deriving stock (TilesetDef -> TilesetDef -> Bool
(TilesetDef -> TilesetDef -> Bool)
-> (TilesetDef -> TilesetDef -> Bool) -> Eq TilesetDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TilesetDef -> TilesetDef -> Bool
$c/= :: TilesetDef -> TilesetDef -> Bool
== :: TilesetDef -> TilesetDef -> Bool
$c== :: TilesetDef -> TilesetDef -> Bool
Eq, Eq TilesetDef
Eq TilesetDef
-> (TilesetDef -> TilesetDef -> Ordering)
-> (TilesetDef -> TilesetDef -> Bool)
-> (TilesetDef -> TilesetDef -> Bool)
-> (TilesetDef -> TilesetDef -> Bool)
-> (TilesetDef -> TilesetDef -> Bool)
-> (TilesetDef -> TilesetDef -> TilesetDef)
-> (TilesetDef -> TilesetDef -> TilesetDef)
-> Ord TilesetDef
TilesetDef -> TilesetDef -> Bool
TilesetDef -> TilesetDef -> Ordering
TilesetDef -> TilesetDef -> TilesetDef
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 :: TilesetDef -> TilesetDef -> TilesetDef
$cmin :: TilesetDef -> TilesetDef -> TilesetDef
max :: TilesetDef -> TilesetDef -> TilesetDef
$cmax :: TilesetDef -> TilesetDef -> TilesetDef
>= :: TilesetDef -> TilesetDef -> Bool
$c>= :: TilesetDef -> TilesetDef -> Bool
> :: TilesetDef -> TilesetDef -> Bool
$c> :: TilesetDef -> TilesetDef -> Bool
<= :: TilesetDef -> TilesetDef -> Bool
$c<= :: TilesetDef -> TilesetDef -> Bool
< :: TilesetDef -> TilesetDef -> Bool
$c< :: TilesetDef -> TilesetDef -> Bool
compare :: TilesetDef -> TilesetDef -> Ordering
$ccompare :: TilesetDef -> TilesetDef -> Ordering
$cp1Ord :: Eq TilesetDef
Ord, Int -> TilesetDef -> String -> String
[TilesetDef] -> String -> String
TilesetDef -> String
(Int -> TilesetDef -> String -> String)
-> (TilesetDef -> String)
-> ([TilesetDef] -> String -> String)
-> Show TilesetDef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TilesetDef] -> String -> String
$cshowList :: [TilesetDef] -> String -> String
show :: TilesetDef -> String
$cshow :: TilesetDef -> String
showsPrec :: Int -> TilesetDef -> String -> String
$cshowsPrec :: Int -> TilesetDef -> String -> String
Show, ReadPrec [TilesetDef]
ReadPrec TilesetDef
Int -> ReadS TilesetDef
ReadS [TilesetDef]
(Int -> ReadS TilesetDef)
-> ReadS [TilesetDef]
-> ReadPrec TilesetDef
-> ReadPrec [TilesetDef]
-> Read TilesetDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TilesetDef]
$creadListPrec :: ReadPrec [TilesetDef]
readPrec :: ReadPrec TilesetDef
$creadPrec :: ReadPrec TilesetDef
readList :: ReadS [TilesetDef]
$creadList :: ReadS [TilesetDef]
readsPrec :: Int -> ReadS TilesetDef
$creadsPrec :: Int -> ReadS TilesetDef
Read, (forall x. TilesetDef -> Rep TilesetDef x)
-> (forall x. Rep TilesetDef x -> TilesetDef) -> Generic TilesetDef
forall x. Rep TilesetDef x -> TilesetDef
forall x. TilesetDef -> Rep TilesetDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TilesetDef x -> TilesetDef
$cfrom :: forall x. TilesetDef -> Rep TilesetDef x
Generic)

data Definitions = Definitions
  { Definitions -> [EntityDef]
entities :: [EntityDef]
  , Definitions -> [EnumDef]
enums :: [EnumDef]
  , Definitions -> [EnumDef]
externalEnums :: [EnumDef]
  , Definitions -> [LayerDef]
layers :: [LayerDef]
  -- , LevelFields :: [FieldDef]
  , Definitions -> [TilesetDef]
tilesets :: [TilesetDef]
  }
  deriving stock (Definitions -> Definitions -> Bool
(Definitions -> Definitions -> Bool)
-> (Definitions -> Definitions -> Bool) -> Eq Definitions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Definitions -> Definitions -> Bool
$c/= :: Definitions -> Definitions -> Bool
== :: Definitions -> Definitions -> Bool
$c== :: Definitions -> Definitions -> Bool
Eq, Eq Definitions
Eq Definitions
-> (Definitions -> Definitions -> Ordering)
-> (Definitions -> Definitions -> Bool)
-> (Definitions -> Definitions -> Bool)
-> (Definitions -> Definitions -> Bool)
-> (Definitions -> Definitions -> Bool)
-> (Definitions -> Definitions -> Definitions)
-> (Definitions -> Definitions -> Definitions)
-> Ord Definitions
Definitions -> Definitions -> Bool
Definitions -> Definitions -> Ordering
Definitions -> Definitions -> Definitions
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 :: Definitions -> Definitions -> Definitions
$cmin :: Definitions -> Definitions -> Definitions
max :: Definitions -> Definitions -> Definitions
$cmax :: Definitions -> Definitions -> Definitions
>= :: Definitions -> Definitions -> Bool
$c>= :: Definitions -> Definitions -> Bool
> :: Definitions -> Definitions -> Bool
$c> :: Definitions -> Definitions -> Bool
<= :: Definitions -> Definitions -> Bool
$c<= :: Definitions -> Definitions -> Bool
< :: Definitions -> Definitions -> Bool
$c< :: Definitions -> Definitions -> Bool
compare :: Definitions -> Definitions -> Ordering
$ccompare :: Definitions -> Definitions -> Ordering
$cp1Ord :: Eq Definitions
Ord, Int -> Definitions -> String -> String
[Definitions] -> String -> String
Definitions -> String
(Int -> Definitions -> String -> String)
-> (Definitions -> String)
-> ([Definitions] -> String -> String)
-> Show Definitions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Definitions] -> String -> String
$cshowList :: [Definitions] -> String -> String
show :: Definitions -> String
$cshow :: Definitions -> String
showsPrec :: Int -> Definitions -> String -> String
$cshowsPrec :: Int -> Definitions -> String -> String
Show, ReadPrec [Definitions]
ReadPrec Definitions
Int -> ReadS Definitions
ReadS [Definitions]
(Int -> ReadS Definitions)
-> ReadS [Definitions]
-> ReadPrec Definitions
-> ReadPrec [Definitions]
-> Read Definitions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Definitions]
$creadListPrec :: ReadPrec [Definitions]
readPrec :: ReadPrec Definitions
$creadPrec :: ReadPrec Definitions
readList :: ReadS [Definitions]
$creadList :: ReadS [Definitions]
readsPrec :: Int -> ReadS Definitions
$creadsPrec :: Int -> ReadS Definitions
Read, (forall x. Definitions -> Rep Definitions x)
-> (forall x. Rep Definitions x -> Definitions)
-> Generic Definitions
forall x. Rep Definitions x -> Definitions
forall x. Definitions -> Rep Definitions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Definitions x -> Definitions
$cfrom :: forall x. Definitions -> Rep Definitions x
Generic)

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

data EnumDef = EnumDef
  { EnumDef -> Maybe String
externalRelPath :: Maybe FilePath
  , EnumDef -> Maybe Int
iconTilesetUid :: Maybe Int
  , EnumDef -> Text
identifier :: Text
  , EnumDef -> [Text]
tags :: [Text]
  , EnumDef -> Int
uid :: Int
  , EnumDef -> [EnumValueDef]
values :: [EnumValueDef]
  }
  deriving stock (EnumDef -> EnumDef -> Bool
(EnumDef -> EnumDef -> Bool)
-> (EnumDef -> EnumDef -> Bool) -> Eq EnumDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumDef -> EnumDef -> Bool
$c/= :: EnumDef -> EnumDef -> Bool
== :: EnumDef -> EnumDef -> Bool
$c== :: EnumDef -> EnumDef -> Bool
Eq, Eq EnumDef
Eq EnumDef
-> (EnumDef -> EnumDef -> Ordering)
-> (EnumDef -> EnumDef -> Bool)
-> (EnumDef -> EnumDef -> Bool)
-> (EnumDef -> EnumDef -> Bool)
-> (EnumDef -> EnumDef -> Bool)
-> (EnumDef -> EnumDef -> EnumDef)
-> (EnumDef -> EnumDef -> EnumDef)
-> Ord EnumDef
EnumDef -> EnumDef -> Bool
EnumDef -> EnumDef -> Ordering
EnumDef -> EnumDef -> EnumDef
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 :: EnumDef -> EnumDef -> EnumDef
$cmin :: EnumDef -> EnumDef -> EnumDef
max :: EnumDef -> EnumDef -> EnumDef
$cmax :: EnumDef -> EnumDef -> EnumDef
>= :: EnumDef -> EnumDef -> Bool
$c>= :: EnumDef -> EnumDef -> Bool
> :: EnumDef -> EnumDef -> Bool
$c> :: EnumDef -> EnumDef -> Bool
<= :: EnumDef -> EnumDef -> Bool
$c<= :: EnumDef -> EnumDef -> Bool
< :: EnumDef -> EnumDef -> Bool
$c< :: EnumDef -> EnumDef -> Bool
compare :: EnumDef -> EnumDef -> Ordering
$ccompare :: EnumDef -> EnumDef -> Ordering
$cp1Ord :: Eq EnumDef
Ord, Int -> EnumDef -> String -> String
[EnumDef] -> String -> String
EnumDef -> String
(Int -> EnumDef -> String -> String)
-> (EnumDef -> String)
-> ([EnumDef] -> String -> String)
-> Show EnumDef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EnumDef] -> String -> String
$cshowList :: [EnumDef] -> String -> String
show :: EnumDef -> String
$cshow :: EnumDef -> String
showsPrec :: Int -> EnumDef -> String -> String
$cshowsPrec :: Int -> EnumDef -> String -> String
Show, ReadPrec [EnumDef]
ReadPrec EnumDef
Int -> ReadS EnumDef
ReadS [EnumDef]
(Int -> ReadS EnumDef)
-> ReadS [EnumDef]
-> ReadPrec EnumDef
-> ReadPrec [EnumDef]
-> Read EnumDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnumDef]
$creadListPrec :: ReadPrec [EnumDef]
readPrec :: ReadPrec EnumDef
$creadPrec :: ReadPrec EnumDef
readList :: ReadS [EnumDef]
$creadList :: ReadS [EnumDef]
readsPrec :: Int -> ReadS EnumDef
$creadsPrec :: Int -> ReadS EnumDef
Read, (forall x. EnumDef -> Rep EnumDef x)
-> (forall x. Rep EnumDef x -> EnumDef) -> Generic EnumDef
forall x. Rep EnumDef x -> EnumDef
forall x. EnumDef -> Rep EnumDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnumDef x -> EnumDef
$cfrom :: forall x. EnumDef -> Rep EnumDef x
Generic)

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

data LayerDef = LayerDef
  { LayerDef -> LayerType
__type :: LayerType
  , LayerDef -> Maybe Int
autoSourceLayerDefUid :: Maybe Int
  , LayerDef -> Float
displayOpacity :: Float
  , LayerDef -> Int
gridSize :: Int
  , LayerDef -> Text
identifier :: Text
  , LayerDef -> [GridValue]
intGridValues :: [GridValue]
  , LayerDef -> Float
parallaxFactorX :: Float
  , LayerDef -> Float
parallaxFactorY :: Float
  , LayerDef -> Bool
parallaxScaling :: Bool
  , LayerDef -> Int
pxOffsetX :: Int
  , LayerDef -> Int
pxOffsetY :: Int
  , LayerDef -> Maybe Int
tilesetDefUid :: Maybe Int
  , LayerDef -> Int
uid :: Int
  }
  deriving stock (LayerDef -> LayerDef -> Bool
(LayerDef -> LayerDef -> Bool)
-> (LayerDef -> LayerDef -> Bool) -> Eq LayerDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerDef -> LayerDef -> Bool
$c/= :: LayerDef -> LayerDef -> Bool
== :: LayerDef -> LayerDef -> Bool
$c== :: LayerDef -> LayerDef -> Bool
Eq, Eq LayerDef
Eq LayerDef
-> (LayerDef -> LayerDef -> Ordering)
-> (LayerDef -> LayerDef -> Bool)
-> (LayerDef -> LayerDef -> Bool)
-> (LayerDef -> LayerDef -> Bool)
-> (LayerDef -> LayerDef -> Bool)
-> (LayerDef -> LayerDef -> LayerDef)
-> (LayerDef -> LayerDef -> LayerDef)
-> Ord LayerDef
LayerDef -> LayerDef -> Bool
LayerDef -> LayerDef -> Ordering
LayerDef -> LayerDef -> LayerDef
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 :: LayerDef -> LayerDef -> LayerDef
$cmin :: LayerDef -> LayerDef -> LayerDef
max :: LayerDef -> LayerDef -> LayerDef
$cmax :: LayerDef -> LayerDef -> LayerDef
>= :: LayerDef -> LayerDef -> Bool
$c>= :: LayerDef -> LayerDef -> Bool
> :: LayerDef -> LayerDef -> Bool
$c> :: LayerDef -> LayerDef -> Bool
<= :: LayerDef -> LayerDef -> Bool
$c<= :: LayerDef -> LayerDef -> Bool
< :: LayerDef -> LayerDef -> Bool
$c< :: LayerDef -> LayerDef -> Bool
compare :: LayerDef -> LayerDef -> Ordering
$ccompare :: LayerDef -> LayerDef -> Ordering
$cp1Ord :: Eq LayerDef
Ord, Int -> LayerDef -> String -> String
[LayerDef] -> String -> String
LayerDef -> String
(Int -> LayerDef -> String -> String)
-> (LayerDef -> String)
-> ([LayerDef] -> String -> String)
-> Show LayerDef
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LayerDef] -> String -> String
$cshowList :: [LayerDef] -> String -> String
show :: LayerDef -> String
$cshow :: LayerDef -> String
showsPrec :: Int -> LayerDef -> String -> String
$cshowsPrec :: Int -> LayerDef -> String -> String
Show, ReadPrec [LayerDef]
ReadPrec LayerDef
Int -> ReadS LayerDef
ReadS [LayerDef]
(Int -> ReadS LayerDef)
-> ReadS [LayerDef]
-> ReadPrec LayerDef
-> ReadPrec [LayerDef]
-> Read LayerDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerDef]
$creadListPrec :: ReadPrec [LayerDef]
readPrec :: ReadPrec LayerDef
$creadPrec :: ReadPrec LayerDef
readList :: ReadS [LayerDef]
$creadList :: ReadS [LayerDef]
readsPrec :: Int -> ReadS LayerDef
$creadsPrec :: Int -> ReadS LayerDef
Read, (forall x. LayerDef -> Rep LayerDef x)
-> (forall x. Rep LayerDef x -> LayerDef) -> Generic LayerDef
forall x. Rep LayerDef x -> LayerDef
forall x. LayerDef -> Rep LayerDef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LayerDef x -> LayerDef
$cfrom :: forall x. LayerDef -> Rep LayerDef x
Generic)

data LDtkRoot = LDtkRoot
  { LDtkRoot -> Color
bgColor :: Color
  , LDtkRoot -> Definitions
defs :: Definitions
  , LDtkRoot -> Bool
externalLevels :: Bool
  , LDtkRoot -> Text
iid :: Text
  , LDtkRoot -> Text
jsonVersion :: Text
  , LDtkRoot -> [Level]
levels :: [Level]
  , LDtkRoot -> Maybe Int
worldGridHeight :: Maybe Int
  , LDtkRoot -> Maybe Int
worldGridWidth :: Maybe Int
  , LDtkRoot -> WorldLayout
worldLayout :: WorldLayout
  , LDtkRoot -> [World]
worlds :: [World]
  }
  deriving stock (LDtkRoot -> LDtkRoot -> Bool
(LDtkRoot -> LDtkRoot -> Bool)
-> (LDtkRoot -> LDtkRoot -> Bool) -> Eq LDtkRoot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LDtkRoot -> LDtkRoot -> Bool
$c/= :: LDtkRoot -> LDtkRoot -> Bool
== :: LDtkRoot -> LDtkRoot -> Bool
$c== :: LDtkRoot -> LDtkRoot -> Bool
Eq, Eq LDtkRoot
Eq LDtkRoot
-> (LDtkRoot -> LDtkRoot -> Ordering)
-> (LDtkRoot -> LDtkRoot -> Bool)
-> (LDtkRoot -> LDtkRoot -> Bool)
-> (LDtkRoot -> LDtkRoot -> Bool)
-> (LDtkRoot -> LDtkRoot -> Bool)
-> (LDtkRoot -> LDtkRoot -> LDtkRoot)
-> (LDtkRoot -> LDtkRoot -> LDtkRoot)
-> Ord LDtkRoot
LDtkRoot -> LDtkRoot -> Bool
LDtkRoot -> LDtkRoot -> Ordering
LDtkRoot -> LDtkRoot -> LDtkRoot
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 :: LDtkRoot -> LDtkRoot -> LDtkRoot
$cmin :: LDtkRoot -> LDtkRoot -> LDtkRoot
max :: LDtkRoot -> LDtkRoot -> LDtkRoot
$cmax :: LDtkRoot -> LDtkRoot -> LDtkRoot
>= :: LDtkRoot -> LDtkRoot -> Bool
$c>= :: LDtkRoot -> LDtkRoot -> Bool
> :: LDtkRoot -> LDtkRoot -> Bool
$c> :: LDtkRoot -> LDtkRoot -> Bool
<= :: LDtkRoot -> LDtkRoot -> Bool
$c<= :: LDtkRoot -> LDtkRoot -> Bool
< :: LDtkRoot -> LDtkRoot -> Bool
$c< :: LDtkRoot -> LDtkRoot -> Bool
compare :: LDtkRoot -> LDtkRoot -> Ordering
$ccompare :: LDtkRoot -> LDtkRoot -> Ordering
$cp1Ord :: Eq LDtkRoot
Ord, Int -> LDtkRoot -> String -> String
[LDtkRoot] -> String -> String
LDtkRoot -> String
(Int -> LDtkRoot -> String -> String)
-> (LDtkRoot -> String)
-> ([LDtkRoot] -> String -> String)
-> Show LDtkRoot
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LDtkRoot] -> String -> String
$cshowList :: [LDtkRoot] -> String -> String
show :: LDtkRoot -> String
$cshow :: LDtkRoot -> String
showsPrec :: Int -> LDtkRoot -> String -> String
$cshowsPrec :: Int -> LDtkRoot -> String -> String
Show, ReadPrec [LDtkRoot]
ReadPrec LDtkRoot
Int -> ReadS LDtkRoot
ReadS [LDtkRoot]
(Int -> ReadS LDtkRoot)
-> ReadS [LDtkRoot]
-> ReadPrec LDtkRoot
-> ReadPrec [LDtkRoot]
-> Read LDtkRoot
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LDtkRoot]
$creadListPrec :: ReadPrec [LDtkRoot]
readPrec :: ReadPrec LDtkRoot
$creadPrec :: ReadPrec LDtkRoot
readList :: ReadS [LDtkRoot]
$creadList :: ReadS [LDtkRoot]
readsPrec :: Int -> ReadS LDtkRoot
$creadsPrec :: Int -> ReadS LDtkRoot
Read, (forall x. LDtkRoot -> Rep LDtkRoot x)
-> (forall x. Rep LDtkRoot x -> LDtkRoot) -> Generic LDtkRoot
forall x. Rep LDtkRoot x -> LDtkRoot
forall x. LDtkRoot -> Rep LDtkRoot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LDtkRoot x -> LDtkRoot
$cfrom :: forall x. LDtkRoot -> Rep LDtkRoot x
Generic)

data TileRenderMode = Cover | FitInside | Repeat | Stretch | FullSizeCropped | FillSizeUncropped | NineSlice
  deriving stock (TileRenderMode -> TileRenderMode -> Bool
(TileRenderMode -> TileRenderMode -> Bool)
-> (TileRenderMode -> TileRenderMode -> Bool) -> Eq TileRenderMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TileRenderMode -> TileRenderMode -> Bool
$c/= :: TileRenderMode -> TileRenderMode -> Bool
== :: TileRenderMode -> TileRenderMode -> Bool
$c== :: TileRenderMode -> TileRenderMode -> Bool
Eq, Eq TileRenderMode
Eq TileRenderMode
-> (TileRenderMode -> TileRenderMode -> Ordering)
-> (TileRenderMode -> TileRenderMode -> Bool)
-> (TileRenderMode -> TileRenderMode -> Bool)
-> (TileRenderMode -> TileRenderMode -> Bool)
-> (TileRenderMode -> TileRenderMode -> Bool)
-> (TileRenderMode -> TileRenderMode -> TileRenderMode)
-> (TileRenderMode -> TileRenderMode -> TileRenderMode)
-> Ord TileRenderMode
TileRenderMode -> TileRenderMode -> Bool
TileRenderMode -> TileRenderMode -> Ordering
TileRenderMode -> TileRenderMode -> TileRenderMode
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 :: TileRenderMode -> TileRenderMode -> TileRenderMode
$cmin :: TileRenderMode -> TileRenderMode -> TileRenderMode
max :: TileRenderMode -> TileRenderMode -> TileRenderMode
$cmax :: TileRenderMode -> TileRenderMode -> TileRenderMode
>= :: TileRenderMode -> TileRenderMode -> Bool
$c>= :: TileRenderMode -> TileRenderMode -> Bool
> :: TileRenderMode -> TileRenderMode -> Bool
$c> :: TileRenderMode -> TileRenderMode -> Bool
<= :: TileRenderMode -> TileRenderMode -> Bool
$c<= :: TileRenderMode -> TileRenderMode -> Bool
< :: TileRenderMode -> TileRenderMode -> Bool
$c< :: TileRenderMode -> TileRenderMode -> Bool
compare :: TileRenderMode -> TileRenderMode -> Ordering
$ccompare :: TileRenderMode -> TileRenderMode -> Ordering
$cp1Ord :: Eq TileRenderMode
Ord, Int -> TileRenderMode -> String -> String
[TileRenderMode] -> String -> String
TileRenderMode -> String
(Int -> TileRenderMode -> String -> String)
-> (TileRenderMode -> String)
-> ([TileRenderMode] -> String -> String)
-> Show TileRenderMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TileRenderMode] -> String -> String
$cshowList :: [TileRenderMode] -> String -> String
show :: TileRenderMode -> String
$cshow :: TileRenderMode -> String
showsPrec :: Int -> TileRenderMode -> String -> String
$cshowsPrec :: Int -> TileRenderMode -> String -> String
Show, ReadPrec [TileRenderMode]
ReadPrec TileRenderMode
Int -> ReadS TileRenderMode
ReadS [TileRenderMode]
(Int -> ReadS TileRenderMode)
-> ReadS [TileRenderMode]
-> ReadPrec TileRenderMode
-> ReadPrec [TileRenderMode]
-> Read TileRenderMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TileRenderMode]
$creadListPrec :: ReadPrec [TileRenderMode]
readPrec :: ReadPrec TileRenderMode
$creadPrec :: ReadPrec TileRenderMode
readList :: ReadS [TileRenderMode]
$creadList :: ReadS [TileRenderMode]
readsPrec :: Int -> ReadS TileRenderMode
$creadsPrec :: Int -> ReadS TileRenderMode
Read, Int -> TileRenderMode
TileRenderMode -> Int
TileRenderMode -> [TileRenderMode]
TileRenderMode -> TileRenderMode
TileRenderMode -> TileRenderMode -> [TileRenderMode]
TileRenderMode
-> TileRenderMode -> TileRenderMode -> [TileRenderMode]
(TileRenderMode -> TileRenderMode)
-> (TileRenderMode -> TileRenderMode)
-> (Int -> TileRenderMode)
-> (TileRenderMode -> Int)
-> (TileRenderMode -> [TileRenderMode])
-> (TileRenderMode -> TileRenderMode -> [TileRenderMode])
-> (TileRenderMode -> TileRenderMode -> [TileRenderMode])
-> (TileRenderMode
    -> TileRenderMode -> TileRenderMode -> [TileRenderMode])
-> Enum TileRenderMode
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 :: TileRenderMode
-> TileRenderMode -> TileRenderMode -> [TileRenderMode]
$cenumFromThenTo :: TileRenderMode
-> TileRenderMode -> TileRenderMode -> [TileRenderMode]
enumFromTo :: TileRenderMode -> TileRenderMode -> [TileRenderMode]
$cenumFromTo :: TileRenderMode -> TileRenderMode -> [TileRenderMode]
enumFromThen :: TileRenderMode -> TileRenderMode -> [TileRenderMode]
$cenumFromThen :: TileRenderMode -> TileRenderMode -> [TileRenderMode]
enumFrom :: TileRenderMode -> [TileRenderMode]
$cenumFrom :: TileRenderMode -> [TileRenderMode]
fromEnum :: TileRenderMode -> Int
$cfromEnum :: TileRenderMode -> Int
toEnum :: Int -> TileRenderMode
$ctoEnum :: Int -> TileRenderMode
pred :: TileRenderMode -> TileRenderMode
$cpred :: TileRenderMode -> TileRenderMode
succ :: TileRenderMode -> TileRenderMode
$csucc :: TileRenderMode -> TileRenderMode
Enum, TileRenderMode
TileRenderMode -> TileRenderMode -> Bounded TileRenderMode
forall a. a -> a -> Bounded a
maxBound :: TileRenderMode
$cmaxBound :: TileRenderMode
minBound :: TileRenderMode
$cminBound :: TileRenderMode
Bounded, (forall x. TileRenderMode -> Rep TileRenderMode x)
-> (forall x. Rep TileRenderMode x -> TileRenderMode)
-> Generic TileRenderMode
forall x. Rep TileRenderMode x -> TileRenderMode
forall x. TileRenderMode -> Rep TileRenderMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TileRenderMode x -> TileRenderMode
$cfrom :: forall x. TileRenderMode -> Rep TileRenderMode x
Generic)
  deriving anyclass (Value -> Parser [TileRenderMode]
Value -> Parser TileRenderMode
(Value -> Parser TileRenderMode)
-> (Value -> Parser [TileRenderMode]) -> FromJSON TileRenderMode
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TileRenderMode]
$cparseJSONList :: Value -> Parser [TileRenderMode]
parseJSON :: Value -> Parser TileRenderMode
$cparseJSON :: Value -> Parser TileRenderMode
FromJSON)

data WorldLayout = Free | GridVania | LinearHorizontal | LinearVertical
  deriving stock (WorldLayout -> WorldLayout -> Bool
(WorldLayout -> WorldLayout -> Bool)
-> (WorldLayout -> WorldLayout -> Bool) -> Eq WorldLayout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorldLayout -> WorldLayout -> Bool
$c/= :: WorldLayout -> WorldLayout -> Bool
== :: WorldLayout -> WorldLayout -> Bool
$c== :: WorldLayout -> WorldLayout -> Bool
Eq, Eq WorldLayout
Eq WorldLayout
-> (WorldLayout -> WorldLayout -> Ordering)
-> (WorldLayout -> WorldLayout -> Bool)
-> (WorldLayout -> WorldLayout -> Bool)
-> (WorldLayout -> WorldLayout -> Bool)
-> (WorldLayout -> WorldLayout -> Bool)
-> (WorldLayout -> WorldLayout -> WorldLayout)
-> (WorldLayout -> WorldLayout -> WorldLayout)
-> Ord WorldLayout
WorldLayout -> WorldLayout -> Bool
WorldLayout -> WorldLayout -> Ordering
WorldLayout -> WorldLayout -> WorldLayout
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 :: WorldLayout -> WorldLayout -> WorldLayout
$cmin :: WorldLayout -> WorldLayout -> WorldLayout
max :: WorldLayout -> WorldLayout -> WorldLayout
$cmax :: WorldLayout -> WorldLayout -> WorldLayout
>= :: WorldLayout -> WorldLayout -> Bool
$c>= :: WorldLayout -> WorldLayout -> Bool
> :: WorldLayout -> WorldLayout -> Bool
$c> :: WorldLayout -> WorldLayout -> Bool
<= :: WorldLayout -> WorldLayout -> Bool
$c<= :: WorldLayout -> WorldLayout -> Bool
< :: WorldLayout -> WorldLayout -> Bool
$c< :: WorldLayout -> WorldLayout -> Bool
compare :: WorldLayout -> WorldLayout -> Ordering
$ccompare :: WorldLayout -> WorldLayout -> Ordering
$cp1Ord :: Eq WorldLayout
Ord, Int -> WorldLayout -> String -> String
[WorldLayout] -> String -> String
WorldLayout -> String
(Int -> WorldLayout -> String -> String)
-> (WorldLayout -> String)
-> ([WorldLayout] -> String -> String)
-> Show WorldLayout
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [WorldLayout] -> String -> String
$cshowList :: [WorldLayout] -> String -> String
show :: WorldLayout -> String
$cshow :: WorldLayout -> String
showsPrec :: Int -> WorldLayout -> String -> String
$cshowsPrec :: Int -> WorldLayout -> String -> String
Show, ReadPrec [WorldLayout]
ReadPrec WorldLayout
Int -> ReadS WorldLayout
ReadS [WorldLayout]
(Int -> ReadS WorldLayout)
-> ReadS [WorldLayout]
-> ReadPrec WorldLayout
-> ReadPrec [WorldLayout]
-> Read WorldLayout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorldLayout]
$creadListPrec :: ReadPrec [WorldLayout]
readPrec :: ReadPrec WorldLayout
$creadPrec :: ReadPrec WorldLayout
readList :: ReadS [WorldLayout]
$creadList :: ReadS [WorldLayout]
readsPrec :: Int -> ReadS WorldLayout
$creadsPrec :: Int -> ReadS WorldLayout
Read, Int -> WorldLayout
WorldLayout -> Int
WorldLayout -> [WorldLayout]
WorldLayout -> WorldLayout
WorldLayout -> WorldLayout -> [WorldLayout]
WorldLayout -> WorldLayout -> WorldLayout -> [WorldLayout]
(WorldLayout -> WorldLayout)
-> (WorldLayout -> WorldLayout)
-> (Int -> WorldLayout)
-> (WorldLayout -> Int)
-> (WorldLayout -> [WorldLayout])
-> (WorldLayout -> WorldLayout -> [WorldLayout])
-> (WorldLayout -> WorldLayout -> [WorldLayout])
-> (WorldLayout -> WorldLayout -> WorldLayout -> [WorldLayout])
-> Enum WorldLayout
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 :: WorldLayout -> WorldLayout -> WorldLayout -> [WorldLayout]
$cenumFromThenTo :: WorldLayout -> WorldLayout -> WorldLayout -> [WorldLayout]
enumFromTo :: WorldLayout -> WorldLayout -> [WorldLayout]
$cenumFromTo :: WorldLayout -> WorldLayout -> [WorldLayout]
enumFromThen :: WorldLayout -> WorldLayout -> [WorldLayout]
$cenumFromThen :: WorldLayout -> WorldLayout -> [WorldLayout]
enumFrom :: WorldLayout -> [WorldLayout]
$cenumFrom :: WorldLayout -> [WorldLayout]
fromEnum :: WorldLayout -> Int
$cfromEnum :: WorldLayout -> Int
toEnum :: Int -> WorldLayout
$ctoEnum :: Int -> WorldLayout
pred :: WorldLayout -> WorldLayout
$cpred :: WorldLayout -> WorldLayout
succ :: WorldLayout -> WorldLayout
$csucc :: WorldLayout -> WorldLayout
Enum, WorldLayout
WorldLayout -> WorldLayout -> Bounded WorldLayout
forall a. a -> a -> Bounded a
maxBound :: WorldLayout
$cmaxBound :: WorldLayout
minBound :: WorldLayout
$cminBound :: WorldLayout
Bounded, (forall x. WorldLayout -> Rep WorldLayout x)
-> (forall x. Rep WorldLayout x -> WorldLayout)
-> Generic WorldLayout
forall x. Rep WorldLayout x -> WorldLayout
forall x. WorldLayout -> Rep WorldLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WorldLayout x -> WorldLayout
$cfrom :: forall x. WorldLayout -> Rep WorldLayout x
Generic)
  deriving anyclass (Value -> Parser [WorldLayout]
Value -> Parser WorldLayout
(Value -> Parser WorldLayout)
-> (Value -> Parser [WorldLayout]) -> FromJSON WorldLayout
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WorldLayout]
$cparseJSONList :: Value -> Parser [WorldLayout]
parseJSON :: Value -> Parser WorldLayout
$cparseJSON :: Value -> Parser WorldLayout
FromJSON)

data LayerType = IntGrid | Entities | Tiles | AutoLayer
  deriving stock (LayerType -> LayerType -> Bool
(LayerType -> LayerType -> Bool)
-> (LayerType -> LayerType -> Bool) -> Eq LayerType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayerType -> LayerType -> Bool
$c/= :: LayerType -> LayerType -> Bool
== :: LayerType -> LayerType -> Bool
$c== :: LayerType -> LayerType -> Bool
Eq, Eq LayerType
Eq LayerType
-> (LayerType -> LayerType -> Ordering)
-> (LayerType -> LayerType -> Bool)
-> (LayerType -> LayerType -> Bool)
-> (LayerType -> LayerType -> Bool)
-> (LayerType -> LayerType -> Bool)
-> (LayerType -> LayerType -> LayerType)
-> (LayerType -> LayerType -> LayerType)
-> Ord LayerType
LayerType -> LayerType -> Bool
LayerType -> LayerType -> Ordering
LayerType -> LayerType -> LayerType
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 :: LayerType -> LayerType -> LayerType
$cmin :: LayerType -> LayerType -> LayerType
max :: LayerType -> LayerType -> LayerType
$cmax :: LayerType -> LayerType -> LayerType
>= :: LayerType -> LayerType -> Bool
$c>= :: LayerType -> LayerType -> Bool
> :: LayerType -> LayerType -> Bool
$c> :: LayerType -> LayerType -> Bool
<= :: LayerType -> LayerType -> Bool
$c<= :: LayerType -> LayerType -> Bool
< :: LayerType -> LayerType -> Bool
$c< :: LayerType -> LayerType -> Bool
compare :: LayerType -> LayerType -> Ordering
$ccompare :: LayerType -> LayerType -> Ordering
$cp1Ord :: Eq LayerType
Ord, Int -> LayerType -> String -> String
[LayerType] -> String -> String
LayerType -> String
(Int -> LayerType -> String -> String)
-> (LayerType -> String)
-> ([LayerType] -> String -> String)
-> Show LayerType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LayerType] -> String -> String
$cshowList :: [LayerType] -> String -> String
show :: LayerType -> String
$cshow :: LayerType -> String
showsPrec :: Int -> LayerType -> String -> String
$cshowsPrec :: Int -> LayerType -> String -> String
Show, ReadPrec [LayerType]
ReadPrec LayerType
Int -> ReadS LayerType
ReadS [LayerType]
(Int -> ReadS LayerType)
-> ReadS [LayerType]
-> ReadPrec LayerType
-> ReadPrec [LayerType]
-> Read LayerType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayerType]
$creadListPrec :: ReadPrec [LayerType]
readPrec :: ReadPrec LayerType
$creadPrec :: ReadPrec LayerType
readList :: ReadS [LayerType]
$creadList :: ReadS [LayerType]
readsPrec :: Int -> ReadS LayerType
$creadsPrec :: Int -> ReadS LayerType
Read, Int -> LayerType
LayerType -> Int
LayerType -> [LayerType]
LayerType -> LayerType
LayerType -> LayerType -> [LayerType]
LayerType -> LayerType -> LayerType -> [LayerType]
(LayerType -> LayerType)
-> (LayerType -> LayerType)
-> (Int -> LayerType)
-> (LayerType -> Int)
-> (LayerType -> [LayerType])
-> (LayerType -> LayerType -> [LayerType])
-> (LayerType -> LayerType -> [LayerType])
-> (LayerType -> LayerType -> LayerType -> [LayerType])
-> Enum LayerType
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 :: LayerType -> LayerType -> LayerType -> [LayerType]
$cenumFromThenTo :: LayerType -> LayerType -> LayerType -> [LayerType]
enumFromTo :: LayerType -> LayerType -> [LayerType]
$cenumFromTo :: LayerType -> LayerType -> [LayerType]
enumFromThen :: LayerType -> LayerType -> [LayerType]
$cenumFromThen :: LayerType -> LayerType -> [LayerType]
enumFrom :: LayerType -> [LayerType]
$cenumFrom :: LayerType -> [LayerType]
fromEnum :: LayerType -> Int
$cfromEnum :: LayerType -> Int
toEnum :: Int -> LayerType
$ctoEnum :: Int -> LayerType
pred :: LayerType -> LayerType
$cpred :: LayerType -> LayerType
succ :: LayerType -> LayerType
$csucc :: LayerType -> LayerType
Enum, LayerType
LayerType -> LayerType -> Bounded LayerType
forall a. a -> a -> Bounded a
maxBound :: LayerType
$cmaxBound :: LayerType
minBound :: LayerType
$cminBound :: LayerType
Bounded, (forall x. LayerType -> Rep LayerType x)
-> (forall x. Rep LayerType x -> LayerType) -> Generic LayerType
forall x. Rep LayerType x -> LayerType
forall x. LayerType -> Rep LayerType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LayerType x -> LayerType
$cfrom :: forall x. LayerType -> Rep LayerType x
Generic)
  deriving anyclass (Value -> Parser [LayerType]
Value -> Parser LayerType
(Value -> Parser LayerType)
-> (Value -> Parser [LayerType]) -> FromJSON LayerType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LayerType]
$cparseJSONList :: Value -> Parser [LayerType]
parseJSON :: Value -> Parser LayerType
$cparseJSON :: Value -> Parser LayerType
FromJSON)

data World = World
  { World -> Text
identifier :: Text
  , World -> Text
iid :: Text
  , World -> [Level]
levels :: [Level]
  , World -> Maybe Int
worldGridHeight :: Maybe Int
  , World -> Maybe Int
worldGridWidth :: Maybe Int
  , World -> WorldLayout
worldLayout :: WorldLayout
  }
  deriving stock (World -> World -> Bool
(World -> World -> Bool) -> (World -> World -> Bool) -> Eq World
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: World -> World -> Bool
$c/= :: World -> World -> Bool
== :: World -> World -> Bool
$c== :: World -> World -> Bool
Eq, Eq World
Eq World
-> (World -> World -> Ordering)
-> (World -> World -> Bool)
-> (World -> World -> Bool)
-> (World -> World -> Bool)
-> (World -> World -> Bool)
-> (World -> World -> World)
-> (World -> World -> World)
-> Ord World
World -> World -> Bool
World -> World -> Ordering
World -> World -> World
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 :: World -> World -> World
$cmin :: World -> World -> World
max :: World -> World -> World
$cmax :: World -> World -> World
>= :: World -> World -> Bool
$c>= :: World -> World -> Bool
> :: World -> World -> Bool
$c> :: World -> World -> Bool
<= :: World -> World -> Bool
$c<= :: World -> World -> Bool
< :: World -> World -> Bool
$c< :: World -> World -> Bool
compare :: World -> World -> Ordering
$ccompare :: World -> World -> Ordering
$cp1Ord :: Eq World
Ord, Int -> World -> String -> String
[World] -> String -> String
World -> String
(Int -> World -> String -> String)
-> (World -> String) -> ([World] -> String -> String) -> Show World
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [World] -> String -> String
$cshowList :: [World] -> String -> String
show :: World -> String
$cshow :: World -> String
showsPrec :: Int -> World -> String -> String
$cshowsPrec :: Int -> World -> String -> String
Show, ReadPrec [World]
ReadPrec World
Int -> ReadS World
ReadS [World]
(Int -> ReadS World)
-> ReadS [World]
-> ReadPrec World
-> ReadPrec [World]
-> Read World
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [World]
$creadListPrec :: ReadPrec [World]
readPrec :: ReadPrec World
$creadPrec :: ReadPrec World
readList :: ReadS [World]
$creadList :: ReadS [World]
readsPrec :: Int -> ReadS World
$creadsPrec :: Int -> ReadS World
Read, (forall x. World -> Rep World x)
-> (forall x. Rep World x -> World) -> Generic World
forall x. Rep World x -> World
forall x. World -> Rep World x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep World x -> World
$cfrom :: forall x. World -> Rep World x
Generic)

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

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

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

instance FromJSON Direction where
  parseJSON :: Value -> Parser Direction
parseJSON Value
v = do
    Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON @String Value
v Parser String -> (String -> Parser Direction) -> Parser Direction
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      String
"n" -> Direction -> Parser Direction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
North
      String
"s" -> Direction -> Parser Direction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
South
      String
"e" -> Direction -> Parser Direction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
East
      String
"w" -> Direction -> Parser Direction
forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
West
      String
x -> String -> Parser Direction
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Direction) -> String -> Parser Direction
forall a b. (a -> b) -> a -> b
$ String
"not a direction: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
x

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

data Level = Level
  { Level -> Color
__bgColor :: Color
  , Level -> Maybe BgPos
__bgPos :: Maybe BgPos
  , Level -> [Neighbour]
__neighbours :: [Neighbour]
  , Level -> Maybe Text
bgRelPath :: Maybe Text
  , Level -> Maybe Text
externalRelPath :: Maybe Text
  , Level -> [Field]
fieldInstances :: [Field]
  , Level -> Text
identifier :: Text
  , Level -> Text
iid :: Text
  , Level -> [Layer]
layerInstances :: [Layer]
  , Level -> Int
pxHei :: Int
  , Level -> Int
pxWid :: Int
  , Level -> Int
uid :: Int
  , Level -> Int
worldDepth :: Int
  , Level -> Int
worldX :: Int
  , Level -> Int
worldY :: Int
  }
  deriving stock (Level -> Level -> Bool
(Level -> Level -> Bool) -> (Level -> Level -> Bool) -> Eq Level
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Level -> Level -> Bool
$c/= :: Level -> Level -> Bool
== :: Level -> Level -> Bool
$c== :: Level -> Level -> Bool
Eq, Eq Level
Eq Level
-> (Level -> Level -> Ordering)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Bool)
-> (Level -> Level -> Level)
-> (Level -> Level -> Level)
-> Ord Level
Level -> Level -> Bool
Level -> Level -> Ordering
Level -> Level -> Level
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 :: Level -> Level -> Level
$cmin :: Level -> Level -> Level
max :: Level -> Level -> Level
$cmax :: Level -> Level -> Level
>= :: Level -> Level -> Bool
$c>= :: Level -> Level -> Bool
> :: Level -> Level -> Bool
$c> :: Level -> Level -> Bool
<= :: Level -> Level -> Bool
$c<= :: Level -> Level -> Bool
< :: Level -> Level -> Bool
$c< :: Level -> Level -> Bool
compare :: Level -> Level -> Ordering
$ccompare :: Level -> Level -> Ordering
$cp1Ord :: Eq Level
Ord, Int -> Level -> String -> String
[Level] -> String -> String
Level -> String
(Int -> Level -> String -> String)
-> (Level -> String) -> ([Level] -> String -> String) -> Show Level
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Level] -> String -> String
$cshowList :: [Level] -> String -> String
show :: Level -> String
$cshow :: Level -> String
showsPrec :: Int -> Level -> String -> String
$cshowsPrec :: Int -> Level -> String -> String
Show, ReadPrec [Level]
ReadPrec Level
Int -> ReadS Level
ReadS [Level]
(Int -> ReadS Level)
-> ReadS [Level]
-> ReadPrec Level
-> ReadPrec [Level]
-> Read Level
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Level]
$creadListPrec :: ReadPrec [Level]
readPrec :: ReadPrec Level
$creadPrec :: ReadPrec Level
readList :: ReadS [Level]
$creadList :: ReadS [Level]
readsPrec :: Int -> ReadS Level
$creadsPrec :: Int -> ReadS Level
Read, (forall x. Level -> Rep Level x)
-> (forall x. Rep Level x -> Level) -> Generic Level
forall x. Rep Level x -> Level
forall x. Level -> Rep Level x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Level x -> Level
$cfrom :: forall x. Level -> Rep Level x
Generic)

data Layer = Layer
  { Layer -> Int
__cHei :: Int
  , Layer -> Int
__cWid :: Int
  , Layer -> Int
__gridSize :: Int
  , Layer -> Text
__identifier :: Text
  , Layer -> Float
__opacity :: Float
  , Layer -> Int
__pxTotalOffsetX :: Int
  , Layer -> Int
__pxTotalOffsetY :: Int
  , Layer -> Maybe Int
__tilesetDefUid :: Maybe Int
  , Layer -> Maybe Text
__tilesetRelPath:: Maybe Text
  , Layer -> LayerType
__type :: LayerType
  , Layer -> [Tile]
autoLayerTiles :: [Tile]
  , Layer -> [Entity]
entityInstances :: [Entity]
  , Layer -> [Tile]
gridTiles :: [Tile]
  , Layer -> Text
iid :: Text
  , Layer -> [Int]
intGridCsv :: [Int]
  , Layer -> Maybe Int
layerDefUid :: Maybe Int
  , Layer -> Maybe Text
tilesetRelPath :: Maybe Text
  , Layer -> Int
levelId :: Int
  , Layer -> Maybe Int
overrideTilesetUid :: Maybe Int
  , Layer -> Bool
visible :: Bool
  }
  deriving stock (Layer -> Layer -> Bool
(Layer -> Layer -> Bool) -> (Layer -> Layer -> Bool) -> Eq Layer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layer -> Layer -> Bool
$c/= :: Layer -> Layer -> Bool
== :: Layer -> Layer -> Bool
$c== :: Layer -> Layer -> Bool
Eq, Eq Layer
Eq Layer
-> (Layer -> Layer -> Ordering)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Bool)
-> (Layer -> Layer -> Layer)
-> (Layer -> Layer -> Layer)
-> Ord Layer
Layer -> Layer -> Bool
Layer -> Layer -> Ordering
Layer -> Layer -> Layer
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 :: Layer -> Layer -> Layer
$cmin :: Layer -> Layer -> Layer
max :: Layer -> Layer -> Layer
$cmax :: Layer -> Layer -> Layer
>= :: Layer -> Layer -> Bool
$c>= :: Layer -> Layer -> Bool
> :: Layer -> Layer -> Bool
$c> :: Layer -> Layer -> Bool
<= :: Layer -> Layer -> Bool
$c<= :: Layer -> Layer -> Bool
< :: Layer -> Layer -> Bool
$c< :: Layer -> Layer -> Bool
compare :: Layer -> Layer -> Ordering
$ccompare :: Layer -> Layer -> Ordering
$cp1Ord :: Eq Layer
Ord, Int -> Layer -> String -> String
[Layer] -> String -> String
Layer -> String
(Int -> Layer -> String -> String)
-> (Layer -> String) -> ([Layer] -> String -> String) -> Show Layer
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Layer] -> String -> String
$cshowList :: [Layer] -> String -> String
show :: Layer -> String
$cshow :: Layer -> String
showsPrec :: Int -> Layer -> String -> String
$cshowsPrec :: Int -> Layer -> String -> String
Show, ReadPrec [Layer]
ReadPrec Layer
Int -> ReadS Layer
ReadS [Layer]
(Int -> ReadS Layer)
-> ReadS [Layer]
-> ReadPrec Layer
-> ReadPrec [Layer]
-> Read Layer
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Layer]
$creadListPrec :: ReadPrec [Layer]
readPrec :: ReadPrec Layer
$creadPrec :: ReadPrec Layer
readList :: ReadS [Layer]
$creadList :: ReadS [Layer]
readsPrec :: Int -> ReadS Layer
$creadsPrec :: Int -> ReadS Layer
Read, (forall x. Layer -> Rep Layer x)
-> (forall x. Rep Layer x -> Layer) -> Generic Layer
forall x. Rep Layer x -> Layer
forall x. Layer -> Rep Layer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Layer x -> Layer
$cfrom :: forall x. Layer -> Rep Layer x
Generic)

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

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

instance FromJSON a => FromJSON (Pair a) where
  parseJSON :: Value -> Parser (Pair a)
parseJSON Value
v = do
    [a
x, a
y] <- Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Pair a -> Parser (Pair a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair a -> Parser (Pair a)) -> Pair a -> Parser (Pair a)
forall a b. (a -> b) -> a -> b
$ a -> a -> Pair a
forall a. a -> a -> Pair a
Pair a
x a
y

instance FromJSON a => FromJSON (Rect a) where
  parseJSON :: Value -> Parser (Rect a)
parseJSON Value
v = do
    [a
x, a
y, a
w, a
h] <- Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Rect a -> Parser (Rect a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rect a -> Parser (Rect a)) -> Rect a -> Parser (Rect a)
forall a b. (a -> b) -> a -> b
$ a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x a
y a
w a
h


data Flip = NoFlip | FlipX | FlipY | FlipXY
  deriving stock (Flip -> Flip -> Bool
(Flip -> Flip -> Bool) -> (Flip -> Flip -> Bool) -> Eq Flip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flip -> Flip -> Bool
$c/= :: Flip -> Flip -> Bool
== :: Flip -> Flip -> Bool
$c== :: Flip -> Flip -> Bool
Eq, Eq Flip
Eq Flip
-> (Flip -> Flip -> Ordering)
-> (Flip -> Flip -> Bool)
-> (Flip -> Flip -> Bool)
-> (Flip -> Flip -> Bool)
-> (Flip -> Flip -> Bool)
-> (Flip -> Flip -> Flip)
-> (Flip -> Flip -> Flip)
-> Ord Flip
Flip -> Flip -> Bool
Flip -> Flip -> Ordering
Flip -> Flip -> Flip
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 :: Flip -> Flip -> Flip
$cmin :: Flip -> Flip -> Flip
max :: Flip -> Flip -> Flip
$cmax :: Flip -> Flip -> Flip
>= :: Flip -> Flip -> Bool
$c>= :: Flip -> Flip -> Bool
> :: Flip -> Flip -> Bool
$c> :: Flip -> Flip -> Bool
<= :: Flip -> Flip -> Bool
$c<= :: Flip -> Flip -> Bool
< :: Flip -> Flip -> Bool
$c< :: Flip -> Flip -> Bool
compare :: Flip -> Flip -> Ordering
$ccompare :: Flip -> Flip -> Ordering
$cp1Ord :: Eq Flip
Ord, Int -> Flip -> String -> String
[Flip] -> String -> String
Flip -> String
(Int -> Flip -> String -> String)
-> (Flip -> String) -> ([Flip] -> String -> String) -> Show Flip
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Flip] -> String -> String
$cshowList :: [Flip] -> String -> String
show :: Flip -> String
$cshow :: Flip -> String
showsPrec :: Int -> Flip -> String -> String
$cshowsPrec :: Int -> Flip -> String -> String
Show, ReadPrec [Flip]
ReadPrec Flip
Int -> ReadS Flip
ReadS [Flip]
(Int -> ReadS Flip)
-> ReadS [Flip] -> ReadPrec Flip -> ReadPrec [Flip] -> Read Flip
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Flip]
$creadListPrec :: ReadPrec [Flip]
readPrec :: ReadPrec Flip
$creadPrec :: ReadPrec Flip
readList :: ReadS [Flip]
$creadList :: ReadS [Flip]
readsPrec :: Int -> ReadS Flip
$creadsPrec :: Int -> ReadS Flip
Read, Int -> Flip
Flip -> Int
Flip -> [Flip]
Flip -> Flip
Flip -> Flip -> [Flip]
Flip -> Flip -> Flip -> [Flip]
(Flip -> Flip)
-> (Flip -> Flip)
-> (Int -> Flip)
-> (Flip -> Int)
-> (Flip -> [Flip])
-> (Flip -> Flip -> [Flip])
-> (Flip -> Flip -> [Flip])
-> (Flip -> Flip -> Flip -> [Flip])
-> Enum Flip
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 :: Flip -> Flip -> Flip -> [Flip]
$cenumFromThenTo :: Flip -> Flip -> Flip -> [Flip]
enumFromTo :: Flip -> Flip -> [Flip]
$cenumFromTo :: Flip -> Flip -> [Flip]
enumFromThen :: Flip -> Flip -> [Flip]
$cenumFromThen :: Flip -> Flip -> [Flip]
enumFrom :: Flip -> [Flip]
$cenumFrom :: Flip -> [Flip]
fromEnum :: Flip -> Int
$cfromEnum :: Flip -> Int
toEnum :: Int -> Flip
$ctoEnum :: Int -> Flip
pred :: Flip -> Flip
$cpred :: Flip -> Flip
succ :: Flip -> Flip
$csucc :: Flip -> Flip
Enum, Flip
Flip -> Flip -> Bounded Flip
forall a. a -> a -> Bounded a
maxBound :: Flip
$cmaxBound :: Flip
minBound :: Flip
$cminBound :: Flip
Bounded, (forall x. Flip -> Rep Flip x)
-> (forall x. Rep Flip x -> Flip) -> Generic Flip
forall x. Rep Flip x -> Flip
forall x. Flip -> Rep Flip x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flip x -> Flip
$cfrom :: forall x. Flip -> Rep Flip x
Generic)

instance FromJSON Flip where
  parseJSON :: Value -> Parser Flip
parseJSON = (Int -> Flip) -> Parser Int -> Parser Flip
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Flip
forall a. Enum a => Int -> a
toEnum (Parser Int -> Parser Flip)
-> (Value -> Parser Int) -> Value -> Parser Flip
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON

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

data FieldValue
  = IntegerValue Integer
  | FloatValue Float
  | BooleanValue Bool
  | StringValue Text
  | FilePathValue FilePath
  | ColorValue Color
  | EnumValue Text
  | PointValue GridPoint
  | TileValue TilesetRect
  | EntityRefValue EntityReferenceInfos
  | ArrayValue [FieldValue]
  deriving stock (FieldValue -> FieldValue -> Bool
(FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool) -> Eq FieldValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldValue -> FieldValue -> Bool
$c/= :: FieldValue -> FieldValue -> Bool
== :: FieldValue -> FieldValue -> Bool
$c== :: FieldValue -> FieldValue -> Bool
Eq, Eq FieldValue
Eq FieldValue
-> (FieldValue -> FieldValue -> Ordering)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> Bool)
-> (FieldValue -> FieldValue -> FieldValue)
-> (FieldValue -> FieldValue -> FieldValue)
-> Ord FieldValue
FieldValue -> FieldValue -> Bool
FieldValue -> FieldValue -> Ordering
FieldValue -> FieldValue -> FieldValue
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 :: FieldValue -> FieldValue -> FieldValue
$cmin :: FieldValue -> FieldValue -> FieldValue
max :: FieldValue -> FieldValue -> FieldValue
$cmax :: FieldValue -> FieldValue -> FieldValue
>= :: FieldValue -> FieldValue -> Bool
$c>= :: FieldValue -> FieldValue -> Bool
> :: FieldValue -> FieldValue -> Bool
$c> :: FieldValue -> FieldValue -> Bool
<= :: FieldValue -> FieldValue -> Bool
$c<= :: FieldValue -> FieldValue -> Bool
< :: FieldValue -> FieldValue -> Bool
$c< :: FieldValue -> FieldValue -> Bool
compare :: FieldValue -> FieldValue -> Ordering
$ccompare :: FieldValue -> FieldValue -> Ordering
$cp1Ord :: Eq FieldValue
Ord, Int -> FieldValue -> String -> String
[FieldValue] -> String -> String
FieldValue -> String
(Int -> FieldValue -> String -> String)
-> (FieldValue -> String)
-> ([FieldValue] -> String -> String)
-> Show FieldValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FieldValue] -> String -> String
$cshowList :: [FieldValue] -> String -> String
show :: FieldValue -> String
$cshow :: FieldValue -> String
showsPrec :: Int -> FieldValue -> String -> String
$cshowsPrec :: Int -> FieldValue -> String -> String
Show, ReadPrec [FieldValue]
ReadPrec FieldValue
Int -> ReadS FieldValue
ReadS [FieldValue]
(Int -> ReadS FieldValue)
-> ReadS [FieldValue]
-> ReadPrec FieldValue
-> ReadPrec [FieldValue]
-> Read FieldValue
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldValue]
$creadListPrec :: ReadPrec [FieldValue]
readPrec :: ReadPrec FieldValue
$creadPrec :: ReadPrec FieldValue
readList :: ReadS [FieldValue]
$creadList :: ReadS [FieldValue]
readsPrec :: Int -> ReadS FieldValue
$creadsPrec :: Int -> ReadS FieldValue
Read, (forall x. FieldValue -> Rep FieldValue x)
-> (forall x. Rep FieldValue x -> FieldValue) -> Generic FieldValue
forall x. Rep FieldValue x -> FieldValue
forall x. FieldValue -> Rep FieldValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldValue x -> FieldValue
$cfrom :: forall x. FieldValue -> Rep FieldValue x
Generic)

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

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

data Entity = Entity
  { Entity -> Pair Int
__grid :: Pair Int
  , Entity -> Text
__identifier :: Text
  , Entity -> Pair Float
__pivot :: Pair Float
  , Entity -> Color
__smartColor :: Color
  , Entity -> [Text]
__tags :: [Text]
  , Entity -> Maybe TilesetRect
__tile :: Maybe TilesetRect
  , Entity -> Int
defUid :: Int
  , Entity -> [Field]
fieldInstances :: [Field]
  , Entity -> Int
height :: Int
  , Entity -> Text
iid :: Text
  , Entity -> Pair Int
px :: Pair Int
  , Entity -> Int
width :: Int
  }
  deriving stock (Entity -> Entity -> Bool
(Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool) -> Eq Entity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entity -> Entity -> Bool
$c/= :: Entity -> Entity -> Bool
== :: Entity -> Entity -> Bool
$c== :: Entity -> Entity -> Bool
Eq, Eq Entity
Eq Entity
-> (Entity -> Entity -> Ordering)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Bool)
-> (Entity -> Entity -> Entity)
-> (Entity -> Entity -> Entity)
-> Ord Entity
Entity -> Entity -> Bool
Entity -> Entity -> Ordering
Entity -> Entity -> Entity
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 :: Entity -> Entity -> Entity
$cmin :: Entity -> Entity -> Entity
max :: Entity -> Entity -> Entity
$cmax :: Entity -> Entity -> Entity
>= :: Entity -> Entity -> Bool
$c>= :: Entity -> Entity -> Bool
> :: Entity -> Entity -> Bool
$c> :: Entity -> Entity -> Bool
<= :: Entity -> Entity -> Bool
$c<= :: Entity -> Entity -> Bool
< :: Entity -> Entity -> Bool
$c< :: Entity -> Entity -> Bool
compare :: Entity -> Entity -> Ordering
$ccompare :: Entity -> Entity -> Ordering
$cp1Ord :: Eq Entity
Ord, Int -> Entity -> String -> String
[Entity] -> String -> String
Entity -> String
(Int -> Entity -> String -> String)
-> (Entity -> String)
-> ([Entity] -> String -> String)
-> Show Entity
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Entity] -> String -> String
$cshowList :: [Entity] -> String -> String
show :: Entity -> String
$cshow :: Entity -> String
showsPrec :: Int -> Entity -> String -> String
$cshowsPrec :: Int -> Entity -> String -> String
Show, ReadPrec [Entity]
ReadPrec Entity
Int -> ReadS Entity
ReadS [Entity]
(Int -> ReadS Entity)
-> ReadS [Entity]
-> ReadPrec Entity
-> ReadPrec [Entity]
-> Read Entity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Entity]
$creadListPrec :: ReadPrec [Entity]
readPrec :: ReadPrec Entity
$creadPrec :: ReadPrec Entity
readList :: ReadS [Entity]
$creadList :: ReadS [Entity]
readsPrec :: Int -> ReadS Entity
$creadsPrec :: Int -> ReadS Entity
Read, (forall x. Entity -> Rep Entity x)
-> (forall x. Rep Entity x -> Entity) -> Generic Entity
forall x. Rep Entity x -> Entity
forall x. Entity -> Rep Entity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Entity x -> Entity
$cfrom :: forall x. Entity -> Rep Entity x
Generic)

data Field = Field
  { Field -> Text
__identifier :: Text
  , Field -> Maybe TilesetRect
__tile :: Maybe TilesetRect
  , Field -> Text
__type :: Text
  , Field -> FieldValue
__value :: FieldValue
  , Field -> Int
defUid :: Int
  }
  deriving stock (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Eq Field
Eq Field
-> (Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
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 :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
$cp1Ord :: Eq Field
Ord, Int -> Field -> String -> String
[Field] -> String -> String
Field -> String
(Int -> Field -> String -> String)
-> (Field -> String) -> ([Field] -> String -> String) -> Show Field
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Field] -> String -> String
$cshowList :: [Field] -> String -> String
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> String -> String
$cshowsPrec :: Int -> Field -> String -> String
Show, ReadPrec [Field]
ReadPrec Field
Int -> ReadS Field
ReadS [Field]
(Int -> ReadS Field)
-> ReadS [Field]
-> ReadPrec Field
-> ReadPrec [Field]
-> Read Field
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Field]
$creadListPrec :: ReadPrec [Field]
readPrec :: ReadPrec Field
$creadPrec :: ReadPrec Field
readList :: ReadS [Field]
$creadList :: ReadS [Field]
readsPrec :: Int -> ReadS Field
$creadsPrec :: Int -> ReadS Field
Read, (forall x. Field -> Rep Field x)
-> (forall x. Rep Field x -> Field) -> Generic Field
forall x. Rep Field x -> Field
forall x. Field -> Rep Field x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Field x -> Field
$cfrom :: forall x. Field -> Rep Field x
Generic)

parseFieldValue :: Text -> Value -> Parser FieldValue
parseFieldValue :: Text -> Value -> Parser FieldValue
parseFieldValue Text
ty Value
v = do
  let (Text
super, Int -> Text -> Text
T.dropEnd Int
1 -> Int -> Text -> Text
T.drop Int
1 -> Text
sub) = (Char -> Bool) -> Text -> (Text, Text)
T.break (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
ty
  case Text
super of
    Text
"Int"    -> Integer -> FieldValue
IntegerValue   (Integer -> FieldValue) -> Parser Integer -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Integer"    -> Integer -> FieldValue
IntegerValue   (Integer -> FieldValue) -> Parser Integer -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Integer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Float"      -> Float -> FieldValue
FloatValue     (Float -> FieldValue) -> Parser Float -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Float
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Bool"    -> Bool -> FieldValue
BooleanValue   (Bool -> FieldValue) -> Parser Bool -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Boolean"    -> Bool -> FieldValue
BooleanValue   (Bool -> FieldValue) -> Parser Bool -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Bool
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"String"     -> Text -> FieldValue
StringValue    (Text -> FieldValue) -> Parser Text -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Multilines" -> Text -> FieldValue
StringValue    (Text -> FieldValue) -> Parser Text -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Text"       -> Text -> FieldValue
StringValue    (Text -> FieldValue) -> Parser Text -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"FilePath"   -> String -> FieldValue
FilePathValue  (String -> FieldValue) -> Parser String -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Color"      -> Color -> FieldValue
ColorValue     (Color -> FieldValue) -> Parser Color -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Color
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Enum"       -> Text -> FieldValue
EnumValue      (Text -> FieldValue) -> Parser Text -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"LocalEnum"       -> Text -> FieldValue
EnumValue      (Text -> FieldValue) -> Parser Text -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Point"      -> GridPoint -> FieldValue
PointValue     (GridPoint -> FieldValue) -> Parser GridPoint -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GridPoint
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Tile"       -> TilesetRect -> FieldValue
TileValue      (TilesetRect -> FieldValue)
-> Parser TilesetRect -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TilesetRect
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"EntityRef"  -> EntityReferenceInfos -> FieldValue
EntityRefValue (EntityReferenceInfos -> FieldValue)
-> Parser EntityReferenceInfos -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser EntityReferenceInfos
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Array"      -> do
      [Value]
arr <- Value -> Parser [Value]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [FieldValue] -> FieldValue
ArrayValue ([FieldValue] -> FieldValue)
-> Parser [FieldValue] -> Parser FieldValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser FieldValue) -> [Value] -> Parser [FieldValue]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Text -> Value -> Parser FieldValue
parseFieldValue Text
sub) [Value]
arr
    Text
x -> String -> Parser FieldValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser FieldValue) -> String -> Parser FieldValue
forall a b. (a -> b) -> a -> b
$ String
"unknown type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
x

instance FromJSON Field where
  parseJSON :: Value -> Parser Field
parseJSON = String -> (Object -> Parser Field) -> Value -> Parser Field
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Field" ((Object -> Parser Field) -> Value -> Parser Field)
-> (Object -> Parser Field) -> Value -> Parser Field
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Text
__identifier <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"__identifier"
    Maybe TilesetRect
__tile <- Object
obj Object -> Text -> Parser (Maybe TilesetRect)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"__tile"
    Text
__type <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"__type"
    Int
defUid <- Object
obj Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"defUid"
    Maybe Value
mv <- Object
obj Object -> Text -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"__value"
    FieldValue
__value <-
      case Maybe Value
mv of
        Just Value
v -> Text -> Value -> Parser FieldValue
parseFieldValue Text
__type Value
v
        Maybe Value
Nothing -> FieldValue -> Parser FieldValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FieldValue -> Parser FieldValue)
-> FieldValue -> Parser FieldValue
forall a b. (a -> b) -> a -> b
$ [FieldValue] -> FieldValue
ArrayValue []
    Field -> Parser Field
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Field -> Parser Field) -> Field -> Parser Field
forall a b. (a -> b) -> a -> b
$ Field :: Text -> Maybe TilesetRect -> Text -> FieldValue -> Int -> Field
Field {Int
Maybe TilesetRect
Text
FieldValue
__value :: FieldValue
defUid :: Int
__type :: Text
__tile :: Maybe TilesetRect
__identifier :: Text
$sel:defUid:Field :: Int
$sel:__value:Field :: FieldValue
$sel:__type:Field :: Text
$sel:__tile:Field :: Maybe TilesetRect
$sel:__identifier:Field :: Text
..}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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