{-# 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 :: FilePath -> FilePath
fieldLabelModifier = \case
      -- Names that are too atrocious to allow
      FilePath
"data'"     -> FilePath
"data"
      FilePath
"enumid"    -> FilePath
"id"
      FilePath
"tile_flip" -> FilePath
"f"
      FilePath
x           -> FilePath
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
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
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
Ord, Int -> Color -> FilePath -> FilePath
[Color] -> FilePath -> FilePath
Color -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Color] -> FilePath -> FilePath
$cshowList :: [Color] -> FilePath -> FilePath
show :: Color -> FilePath
$cshow :: Color -> FilePath
showsPrec :: Int -> Color -> FilePath -> FilePath
$cshowsPrec :: Int -> Color -> FilePath -> FilePath
Show, ReadPrec [Color]
ReadPrec Color
Int -> ReadS Color
ReadS [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. 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 : []) <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    let safe_read :: [(a, b)] -> Parser (Maybe a)
safe_read = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst
    Just Word8
r <- forall {a} {b}. [(a, b)] -> Parser (Maybe a)
safe_read forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => ReadS a
readHex [Char
r1, Char
r2]
    Just Word8
g <- forall {a} {b}. [(a, b)] -> Parser (Maybe a)
safe_read forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => ReadS a
readHex [Char
g1, Char
g2]
    Just Word8
b <- forall {a} {b}. [(a, b)] -> Parser (Maybe a)
safe_read forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Num a) => ReadS a
readHex [Char
b1, Char
b2]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
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
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
Ord, Int -> EntityDef -> FilePath -> FilePath
[EntityDef] -> FilePath -> FilePath
EntityDef -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EntityDef] -> FilePath -> FilePath
$cshowList :: [EntityDef] -> FilePath -> FilePath
show :: EntityDef -> FilePath
$cshow :: EntityDef -> FilePath
showsPrec :: Int -> EntityDef -> FilePath -> FilePath
$cshowsPrec :: Int -> EntityDef -> FilePath -> FilePath
Show, ReadPrec [EntityDef]
ReadPrec EntityDef
Int -> ReadS EntityDef
ReadS [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. 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
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
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
Ord, Int -> EmbedAtlas -> FilePath -> FilePath
[EmbedAtlas] -> FilePath -> FilePath
EmbedAtlas -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EmbedAtlas] -> FilePath -> FilePath
$cshowList :: [EmbedAtlas] -> FilePath -> FilePath
show :: EmbedAtlas -> FilePath
$cshow :: EmbedAtlas -> FilePath
showsPrec :: Int -> EmbedAtlas -> FilePath -> FilePath
$cshowsPrec :: Int -> EmbedAtlas -> FilePath -> FilePath
Show, ReadPrec [EmbedAtlas]
ReadPrec EmbedAtlas
Int -> ReadS EmbedAtlas
ReadS [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]
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
forall a. a -> a -> Bounded a
maxBound :: EmbedAtlas
$cmaxBound :: EmbedAtlas
minBound :: EmbedAtlas
$cminBound :: EmbedAtlas
Bounded, 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
    FilePath
"LdtkIcons" <- forall a. FromJSON a => Value -> Parser a
parseJSON @String Value
v
    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
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
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
Ord, Int -> CustomData -> FilePath -> FilePath
[CustomData] -> FilePath -> FilePath
CustomData -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [CustomData] -> FilePath -> FilePath
$cshowList :: [CustomData] -> FilePath -> FilePath
show :: CustomData -> FilePath
$cshow :: CustomData -> FilePath
showsPrec :: Int -> CustomData -> FilePath -> FilePath
$cshowsPrec :: Int -> CustomData -> FilePath -> FilePath
Show, ReadPrec [CustomData]
ReadPrec CustomData
Int -> ReadS CustomData
ReadS [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. 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
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
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
Ord, Int -> EnumTag -> FilePath -> FilePath
[EnumTag] -> FilePath -> FilePath
EnumTag -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EnumTag] -> FilePath -> FilePath
$cshowList :: [EnumTag] -> FilePath -> FilePath
show :: EnumTag -> FilePath
$cshow :: EnumTag -> FilePath
showsPrec :: Int -> EnumTag -> FilePath -> FilePath
$cshowsPrec :: Int -> EnumTag -> FilePath -> FilePath
Show, ReadPrec [EnumTag]
ReadPrec EnumTag
Int -> ReadS EnumTag
ReadS [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. 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 FilePath
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
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
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
Ord, Int -> TilesetDef -> FilePath -> FilePath
[TilesetDef] -> FilePath -> FilePath
TilesetDef -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [TilesetDef] -> FilePath -> FilePath
$cshowList :: [TilesetDef] -> FilePath -> FilePath
show :: TilesetDef -> FilePath
$cshow :: TilesetDef -> FilePath
showsPrec :: Int -> TilesetDef -> FilePath -> FilePath
$cshowsPrec :: Int -> TilesetDef -> FilePath -> FilePath
Show, ReadPrec [TilesetDef]
ReadPrec TilesetDef
Int -> ReadS TilesetDef
ReadS [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. 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
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
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
Ord, Int -> Definitions -> FilePath -> FilePath
[Definitions] -> FilePath -> FilePath
Definitions -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Definitions] -> FilePath -> FilePath
$cshowList :: [Definitions] -> FilePath -> FilePath
show :: Definitions -> FilePath
$cshow :: Definitions -> FilePath
showsPrec :: Int -> Definitions -> FilePath -> FilePath
$cshowsPrec :: Int -> Definitions -> FilePath -> FilePath
Show, ReadPrec [Definitions]
ReadPrec Definitions
Int -> ReadS Definitions
ReadS [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. 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 -> Rect Int
__tileSrcRect :: Rect Int
  , EnumValueDef -> Int
color :: Int
  , EnumValueDef -> Text
enumid :: Text
  , EnumValueDef -> Maybe Int
tileId :: Maybe Int
  }
  deriving stock (EnumValueDef -> EnumValueDef -> Bool
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
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
Ord, Int -> EnumValueDef -> FilePath -> FilePath
[EnumValueDef] -> FilePath -> FilePath
EnumValueDef -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EnumValueDef] -> FilePath -> FilePath
$cshowList :: [EnumValueDef] -> FilePath -> FilePath
show :: EnumValueDef -> FilePath
$cshow :: EnumValueDef -> FilePath
showsPrec :: Int -> EnumValueDef -> FilePath -> FilePath
$cshowsPrec :: Int -> EnumValueDef -> FilePath -> FilePath
Show, ReadPrec [EnumValueDef]
ReadPrec EnumValueDef
Int -> ReadS EnumValueDef
ReadS [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. 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 FilePath
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
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
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
Ord, Int -> EnumDef -> FilePath -> FilePath
[EnumDef] -> FilePath -> FilePath
EnumDef -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EnumDef] -> FilePath -> FilePath
$cshowList :: [EnumDef] -> FilePath -> FilePath
show :: EnumDef -> FilePath
$cshow :: EnumDef -> FilePath
showsPrec :: Int -> EnumDef -> FilePath -> FilePath
$cshowsPrec :: Int -> EnumDef -> FilePath -> FilePath
Show, ReadPrec [EnumDef]
ReadPrec EnumDef
Int -> ReadS EnumDef
ReadS [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. 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
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
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
Ord, Int -> GridValue -> FilePath -> FilePath
[GridValue] -> FilePath -> FilePath
GridValue -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GridValue] -> FilePath -> FilePath
$cshowList :: [GridValue] -> FilePath -> FilePath
show :: GridValue -> FilePath
$cshow :: GridValue -> FilePath
showsPrec :: Int -> GridValue -> FilePath -> FilePath
$cshowsPrec :: Int -> GridValue -> FilePath -> FilePath
Show, ReadPrec [GridValue]
ReadPrec GridValue
Int -> ReadS GridValue
ReadS [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. 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
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
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
Ord, Int -> LayerDef -> FilePath -> FilePath
[LayerDef] -> FilePath -> FilePath
LayerDef -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LayerDef] -> FilePath -> FilePath
$cshowList :: [LayerDef] -> FilePath -> FilePath
show :: LayerDef -> FilePath
$cshow :: LayerDef -> FilePath
showsPrec :: Int -> LayerDef -> FilePath -> FilePath
$cshowsPrec :: Int -> LayerDef -> FilePath -> FilePath
Show, ReadPrec [LayerDef]
ReadPrec LayerDef
Int -> ReadS LayerDef
ReadS [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. 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
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
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
Ord, Int -> LDtkRoot -> FilePath -> FilePath
[LDtkRoot] -> FilePath -> FilePath
LDtkRoot -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LDtkRoot] -> FilePath -> FilePath
$cshowList :: [LDtkRoot] -> FilePath -> FilePath
show :: LDtkRoot -> FilePath
$cshow :: LDtkRoot -> FilePath
showsPrec :: Int -> LDtkRoot -> FilePath -> FilePath
$cshowsPrec :: Int -> LDtkRoot -> FilePath -> FilePath
Show, ReadPrec [LDtkRoot]
ReadPrec LDtkRoot
Int -> ReadS LDtkRoot
ReadS [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. 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
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
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
Ord, Int -> TileRenderMode -> FilePath -> FilePath
[TileRenderMode] -> FilePath -> FilePath
TileRenderMode -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [TileRenderMode] -> FilePath -> FilePath
$cshowList :: [TileRenderMode] -> FilePath -> FilePath
show :: TileRenderMode -> FilePath
$cshow :: TileRenderMode -> FilePath
showsPrec :: Int -> TileRenderMode -> FilePath -> FilePath
$cshowsPrec :: Int -> TileRenderMode -> FilePath -> FilePath
Show, ReadPrec [TileRenderMode]
ReadPrec TileRenderMode
Int -> ReadS TileRenderMode
ReadS [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]
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
forall a. a -> a -> Bounded a
maxBound :: TileRenderMode
$cmaxBound :: TileRenderMode
minBound :: TileRenderMode
$cminBound :: TileRenderMode
Bounded, 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
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
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
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
Ord, Int -> WorldLayout -> FilePath -> FilePath
[WorldLayout] -> FilePath -> FilePath
WorldLayout -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [WorldLayout] -> FilePath -> FilePath
$cshowList :: [WorldLayout] -> FilePath -> FilePath
show :: WorldLayout -> FilePath
$cshow :: WorldLayout -> FilePath
showsPrec :: Int -> WorldLayout -> FilePath -> FilePath
$cshowsPrec :: Int -> WorldLayout -> FilePath -> FilePath
Show, ReadPrec [WorldLayout]
ReadPrec WorldLayout
Int -> ReadS WorldLayout
ReadS [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]
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
forall a. a -> a -> Bounded a
maxBound :: WorldLayout
$cmaxBound :: WorldLayout
minBound :: WorldLayout
$cminBound :: WorldLayout
Bounded, 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
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
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
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
Ord, Int -> LayerType -> FilePath -> FilePath
[LayerType] -> FilePath -> FilePath
LayerType -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [LayerType] -> FilePath -> FilePath
$cshowList :: [LayerType] -> FilePath -> FilePath
show :: LayerType -> FilePath
$cshow :: LayerType -> FilePath
showsPrec :: Int -> LayerType -> FilePath -> FilePath
$cshowsPrec :: Int -> LayerType -> FilePath -> FilePath
Show, ReadPrec [LayerType]
ReadPrec LayerType
Int -> ReadS LayerType
ReadS [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]
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
forall a. a -> a -> Bounded a
maxBound :: LayerType
$cmaxBound :: LayerType
minBound :: LayerType
$cminBound :: LayerType
Bounded, 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
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
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
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
Ord, Int -> World -> FilePath -> FilePath
[World] -> FilePath -> FilePath
World -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [World] -> FilePath -> FilePath
$cshowList :: [World] -> FilePath -> FilePath
show :: World -> FilePath
$cshow :: World -> FilePath
showsPrec :: Int -> World -> FilePath -> FilePath
$cshowsPrec :: Int -> World -> FilePath -> FilePath
Show, ReadPrec [World]
ReadPrec World
Int -> ReadS World
ReadS [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. 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
  { forall a. Rect a -> a
r_x :: a
  , forall a. Rect a -> a
r_y :: a
  , forall a. Rect a -> a
r_width :: a
  , forall a. Rect a -> a
r_height :: a
  }
  deriving stock (Rect a -> Rect a -> Bool
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, Rect a -> Rect a -> Bool
Rect a -> Rect a -> Ordering
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
Ord, Int -> Rect a -> FilePath -> FilePath
forall a. Show a => Int -> Rect a -> FilePath -> FilePath
forall a. Show a => [Rect a] -> FilePath -> FilePath
forall a. Show a => Rect a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Rect a] -> FilePath -> FilePath
$cshowList :: forall a. Show a => [Rect a] -> FilePath -> FilePath
show :: Rect a -> FilePath
$cshow :: forall a. Show a => Rect a -> FilePath
showsPrec :: Int -> Rect a -> FilePath -> FilePath
$cshowsPrec :: forall a. Show a => Int -> Rect a -> FilePath -> FilePath
Show, ReadPrec [Rect a]
ReadPrec (Rect a)
ReadS [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 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
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
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
Ord, Int -> BgPos -> FilePath -> FilePath
[BgPos] -> FilePath -> FilePath
BgPos -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [BgPos] -> FilePath -> FilePath
$cshowList :: [BgPos] -> FilePath -> FilePath
show :: BgPos -> FilePath
$cshow :: BgPos -> FilePath
showsPrec :: Int -> BgPos -> FilePath -> FilePath
$cshowsPrec :: Int -> BgPos -> FilePath -> FilePath
Show, ReadPrec [BgPos]
ReadPrec BgPos
Int -> ReadS BgPos
ReadS [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. 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
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
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
Ord, Int -> Direction -> FilePath -> FilePath
[Direction] -> FilePath -> FilePath
Direction -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Direction] -> FilePath -> FilePath
$cshowList :: [Direction] -> FilePath -> FilePath
show :: Direction -> FilePath
$cshow :: Direction -> FilePath
showsPrec :: Int -> Direction -> FilePath -> FilePath
$cshowsPrec :: Int -> Direction -> FilePath -> FilePath
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [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. 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
    forall a. FromJSON a => Value -> Parser a
parseJSON @String Value
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      FilePath
"n" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
North
      FilePath
"s" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
South
      FilePath
"e" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
East
      FilePath
"w" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Direction
West
      FilePath
x -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"not a direction: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
x

data Neighbour = Neighbour
  { Neighbour -> Direction
dir :: Direction
  , Neighbour -> Text
levelIid :: Text
  }
  deriving stock (Neighbour -> Neighbour -> Bool
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
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
Ord, Int -> Neighbour -> FilePath -> FilePath
[Neighbour] -> FilePath -> FilePath
Neighbour -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Neighbour] -> FilePath -> FilePath
$cshowList :: [Neighbour] -> FilePath -> FilePath
show :: Neighbour -> FilePath
$cshow :: Neighbour -> FilePath
showsPrec :: Int -> Neighbour -> FilePath -> FilePath
$cshowsPrec :: Int -> Neighbour -> FilePath -> FilePath
Show, ReadPrec [Neighbour]
ReadPrec Neighbour
Int -> ReadS Neighbour
ReadS [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. 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
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
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
Ord, Int -> Level -> FilePath -> FilePath
[Level] -> FilePath -> FilePath
Level -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Level] -> FilePath -> FilePath
$cshowList :: [Level] -> FilePath -> FilePath
show :: Level -> FilePath
$cshow :: Level -> FilePath
showsPrec :: Int -> Level -> FilePath -> FilePath
$cshowsPrec :: Int -> Level -> FilePath -> FilePath
Show, ReadPrec [Level]
ReadPrec Level
Int -> ReadS Level
ReadS [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. 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
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
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
Ord, Int -> Layer -> FilePath -> FilePath
[Layer] -> FilePath -> FilePath
Layer -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Layer] -> FilePath -> FilePath
$cshowList :: [Layer] -> FilePath -> FilePath
show :: Layer -> FilePath
$cshow :: Layer -> FilePath
showsPrec :: Int -> Layer -> FilePath -> FilePath
$cshowsPrec :: Int -> Layer -> FilePath -> FilePath
Show, ReadPrec [Layer]
ReadPrec Layer
Int -> ReadS Layer
ReadS [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. 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
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
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
Ord, Int -> GridPoint -> FilePath -> FilePath
[GridPoint] -> FilePath -> FilePath
GridPoint -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GridPoint] -> FilePath -> FilePath
$cshowList :: [GridPoint] -> FilePath -> FilePath
show :: GridPoint -> FilePath
$cshow :: GridPoint -> FilePath
showsPrec :: Int -> GridPoint -> FilePath -> FilePath
$cshowsPrec :: Int -> GridPoint -> FilePath -> FilePath
Show, ReadPrec [GridPoint]
ReadPrec GridPoint
Int -> ReadS GridPoint
ReadS [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. 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
  { forall a. Pair a -> a
p_x :: a
  , forall a. Pair a -> a
p_y :: a
  }
  deriving stock (Pair a -> Pair a -> Bool
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, Pair a -> Pair a -> Bool
Pair a -> Pair a -> Ordering
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
Ord, Int -> Pair a -> FilePath -> FilePath
forall a. Show a => Int -> Pair a -> FilePath -> FilePath
forall a. Show a => [Pair a] -> FilePath -> FilePath
forall a. Show a => Pair a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Pair a] -> FilePath -> FilePath
$cshowList :: forall a. Show a => [Pair a] -> FilePath -> FilePath
show :: Pair a -> FilePath
$cshow :: forall a. Show a => Pair a -> FilePath
showsPrec :: Int -> Pair a -> FilePath -> FilePath
$cshowsPrec :: forall a. Show a => Int -> Pair a -> FilePath -> FilePath
Show, ReadPrec [Pair a]
ReadPrec (Pair a)
ReadS [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 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] <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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] <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
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
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
Ord, Int -> Flip -> FilePath -> FilePath
[Flip] -> FilePath -> FilePath
Flip -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Flip] -> FilePath -> FilePath
$cshowList :: [Flip] -> FilePath -> FilePath
show :: Flip -> FilePath
$cshow :: Flip -> FilePath
showsPrec :: Int -> Flip -> FilePath -> FilePath
$cshowsPrec :: Int -> Flip -> FilePath -> FilePath
Show, ReadPrec [Flip]
ReadPrec Flip
Int -> ReadS Flip
ReadS [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]
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
forall a. a -> a -> Bounded a
maxBound :: Flip
$cmaxBound :: Flip
minBound :: Flip
$cminBound :: Flip
Bounded, 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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
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
Ord, Int -> EntityReferenceInfos -> FilePath -> FilePath
[EntityReferenceInfos] -> FilePath -> FilePath
EntityReferenceInfos -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [EntityReferenceInfos] -> FilePath -> FilePath
$cshowList :: [EntityReferenceInfos] -> FilePath -> FilePath
show :: EntityReferenceInfos -> FilePath
$cshow :: EntityReferenceInfos -> FilePath
showsPrec :: Int -> EntityReferenceInfos -> FilePath -> FilePath
$cshowsPrec :: Int -> EntityReferenceInfos -> FilePath -> FilePath
Show, ReadPrec [EntityReferenceInfos]
ReadPrec EntityReferenceInfos
Int -> ReadS EntityReferenceInfos
ReadS [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. 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
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
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
Ord, Int -> FieldValue -> FilePath -> FilePath
[FieldValue] -> FilePath -> FilePath
FieldValue -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [FieldValue] -> FilePath -> FilePath
$cshowList :: [FieldValue] -> FilePath -> FilePath
show :: FieldValue -> FilePath
$cshow :: FieldValue -> FilePath
showsPrec :: Int -> FieldValue -> FilePath -> FilePath
$cshowsPrec :: Int -> FieldValue -> FilePath -> FilePath
Show, ReadPrec [FieldValue]
ReadPrec FieldValue
Int -> ReadS FieldValue
ReadS [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. 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
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
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
Ord, Int -> TilesetRect -> FilePath -> FilePath
[TilesetRect] -> FilePath -> FilePath
TilesetRect -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [TilesetRect] -> FilePath -> FilePath
$cshowList :: [TilesetRect] -> FilePath -> FilePath
show :: TilesetRect -> FilePath
$cshow :: TilesetRect -> FilePath
showsPrec :: Int -> TilesetRect -> FilePath -> FilePath
$cshowsPrec :: Int -> TilesetRect -> FilePath -> FilePath
Show, ReadPrec [TilesetRect]
ReadPrec TilesetRect
Int -> ReadS TilesetRect
ReadS [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. 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
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
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
Ord, Int -> Tile -> FilePath -> FilePath
[Tile] -> FilePath -> FilePath
Tile -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Tile] -> FilePath -> FilePath
$cshowList :: [Tile] -> FilePath -> FilePath
show :: Tile -> FilePath
$cshow :: Tile -> FilePath
showsPrec :: Int -> Tile -> FilePath -> FilePath
$cshowsPrec :: Int -> Tile -> FilePath -> FilePath
Show, ReadPrec [Tile]
ReadPrec Tile
Int -> ReadS Tile
ReadS [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. 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
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
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
Ord, Int -> Entity -> FilePath -> FilePath
[Entity] -> FilePath -> FilePath
Entity -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Entity] -> FilePath -> FilePath
$cshowList :: [Entity] -> FilePath -> FilePath
show :: Entity -> FilePath
$cshow :: Entity -> FilePath
showsPrec :: Int -> Entity -> FilePath -> FilePath
$cshowsPrec :: Int -> Entity -> FilePath -> FilePath
Show, ReadPrec [Entity]
ReadPrec Entity
Int -> ReadS Entity
ReadS [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. 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
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
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
Ord, Int -> Field -> FilePath -> FilePath
[Field] -> FilePath -> FilePath
Field -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [Field] -> FilePath -> FilePath
$cshowList :: [Field] -> FilePath -> FilePath
show :: Field -> FilePath
$cshow :: Field -> FilePath
showsPrec :: Int -> Field -> FilePath -> FilePath
$cshowsPrec :: Int -> Field -> FilePath -> FilePath
Show, ReadPrec [Field]
ReadPrec Field
Int -> ReadS Field
ReadS [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. 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 forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.') Text
ty
  case Text
super of
    Text
"Int"    -> Integer -> FieldValue
IntegerValue   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Integer"    -> Integer -> FieldValue
IntegerValue   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Float"      -> Float -> FieldValue
FloatValue     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Bool"    -> Bool -> FieldValue
BooleanValue   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Boolean"    -> Bool -> FieldValue
BooleanValue   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"String"     -> Text -> FieldValue
StringValue    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Multilines" -> Text -> FieldValue
StringValue    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Text"       -> Text -> FieldValue
StringValue    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"FilePath"   -> FilePath -> FieldValue
FilePathValue  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Color"      -> Color -> FieldValue
ColorValue     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Enum"       -> Text -> FieldValue
EnumValue      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"LocalEnum"       -> Text -> FieldValue
EnumValue      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Point"      -> GridPoint -> FieldValue
PointValue     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Tile"       -> TilesetRect -> FieldValue
TileValue      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"EntityRef"  -> EntityReferenceInfos -> FieldValue
EntityRefValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Text
"Array"      -> do
      [Value]
arr <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      [FieldValue] -> FieldValue
ArrayValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"unknown type " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show Text
x

instance FromJSON Field where
  parseJSON :: Value -> Parser Field
parseJSON = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
withObject FilePath
"Field" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    Text
__identifier <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__identifier"
    Maybe TilesetRect
__tile <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__tile"
    Text
__type <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__type"
    Int
defUid <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"defUid"
    Maybe Value
mv <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"__value"
    FieldValue
__value <-
      case Maybe Value
mv of
        Just Value
v -> Text -> Value -> Parser FieldValue
parseFieldValue Text
__type Value
v
        Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [FieldValue] -> FieldValue
ArrayValue []
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
ldtkOpts

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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