{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RecordWildCards            #-}
-- | This module provides Haskell types for Tiled's JSON exports, which you can
-- read about at http://doc.mapeditor.org/en/latest/reference/json-map-format/.
-- That said - as of the writing of this module the JSON documentation does not
-- cover some of the types and records that are available in the format. For
-- those you should read the TMX documentation at
-- http://doc.mapeditor.org/en/latest/reference/tmx-map-format/
module Data.Aeson.Tiled
  ( -- * Tiled map editor types, their aeson instances and map loading
    module Data.Aeson.Tiled
    -- * Re-exports for working with Tiled types
  , module Data.Map
  , module Data.Vector
  ) where

import           Control.Applicative        ((<|>))
import           Control.Monad              (forM)
import           Data.Aeson                 hiding (Object)
import qualified Data.Aeson                 as A
import           Data.Aeson.Types           (Parser, typeMismatch)
import qualified Data.ByteString.Lazy.Char8 as C8
import           Data.Map                   (Map)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromMaybe)
import           Data.Text                  (Text)
import           Data.Vector                (Vector)
import           GHC.Exts                   (fromList, toList)
import           GHC.Generics               (Generic)


-- | A globally indexed identifier.
newtype GlobalId = GlobalId { GlobalId -> Int
unGlobalId :: Int }
  deriving (Eq GlobalId
Eq GlobalId
-> (GlobalId -> GlobalId -> Ordering)
-> (GlobalId -> GlobalId -> Bool)
-> (GlobalId -> GlobalId -> Bool)
-> (GlobalId -> GlobalId -> Bool)
-> (GlobalId -> GlobalId -> Bool)
-> (GlobalId -> GlobalId -> GlobalId)
-> (GlobalId -> GlobalId -> GlobalId)
-> Ord GlobalId
GlobalId -> GlobalId -> Bool
GlobalId -> GlobalId -> Ordering
GlobalId -> GlobalId -> GlobalId
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 :: GlobalId -> GlobalId -> GlobalId
$cmin :: GlobalId -> GlobalId -> GlobalId
max :: GlobalId -> GlobalId -> GlobalId
$cmax :: GlobalId -> GlobalId -> GlobalId
>= :: GlobalId -> GlobalId -> Bool
$c>= :: GlobalId -> GlobalId -> Bool
> :: GlobalId -> GlobalId -> Bool
$c> :: GlobalId -> GlobalId -> Bool
<= :: GlobalId -> GlobalId -> Bool
$c<= :: GlobalId -> GlobalId -> Bool
< :: GlobalId -> GlobalId -> Bool
$c< :: GlobalId -> GlobalId -> Bool
compare :: GlobalId -> GlobalId -> Ordering
$ccompare :: GlobalId -> GlobalId -> Ordering
$cp1Ord :: Eq GlobalId
Ord, GlobalId -> GlobalId -> Bool
(GlobalId -> GlobalId -> Bool)
-> (GlobalId -> GlobalId -> Bool) -> Eq GlobalId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalId -> GlobalId -> Bool
$c/= :: GlobalId -> GlobalId -> Bool
== :: GlobalId -> GlobalId -> Bool
$c== :: GlobalId -> GlobalId -> Bool
Eq, Int -> GlobalId
GlobalId -> Int
GlobalId -> [GlobalId]
GlobalId -> GlobalId
GlobalId -> GlobalId -> [GlobalId]
GlobalId -> GlobalId -> GlobalId -> [GlobalId]
(GlobalId -> GlobalId)
-> (GlobalId -> GlobalId)
-> (Int -> GlobalId)
-> (GlobalId -> Int)
-> (GlobalId -> [GlobalId])
-> (GlobalId -> GlobalId -> [GlobalId])
-> (GlobalId -> GlobalId -> [GlobalId])
-> (GlobalId -> GlobalId -> GlobalId -> [GlobalId])
-> Enum GlobalId
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 :: GlobalId -> GlobalId -> GlobalId -> [GlobalId]
$cenumFromThenTo :: GlobalId -> GlobalId -> GlobalId -> [GlobalId]
enumFromTo :: GlobalId -> GlobalId -> [GlobalId]
$cenumFromTo :: GlobalId -> GlobalId -> [GlobalId]
enumFromThen :: GlobalId -> GlobalId -> [GlobalId]
$cenumFromThen :: GlobalId -> GlobalId -> [GlobalId]
enumFrom :: GlobalId -> [GlobalId]
$cenumFrom :: GlobalId -> [GlobalId]
fromEnum :: GlobalId -> Int
$cfromEnum :: GlobalId -> Int
toEnum :: Int -> GlobalId
$ctoEnum :: Int -> GlobalId
pred :: GlobalId -> GlobalId
$cpred :: GlobalId -> GlobalId
succ :: GlobalId -> GlobalId
$csucc :: GlobalId -> GlobalId
Enum, Integer -> GlobalId
GlobalId -> GlobalId
GlobalId -> GlobalId -> GlobalId
(GlobalId -> GlobalId -> GlobalId)
-> (GlobalId -> GlobalId -> GlobalId)
-> (GlobalId -> GlobalId -> GlobalId)
-> (GlobalId -> GlobalId)
-> (GlobalId -> GlobalId)
-> (GlobalId -> GlobalId)
-> (Integer -> GlobalId)
-> Num GlobalId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> GlobalId
$cfromInteger :: Integer -> GlobalId
signum :: GlobalId -> GlobalId
$csignum :: GlobalId -> GlobalId
abs :: GlobalId -> GlobalId
$cabs :: GlobalId -> GlobalId
negate :: GlobalId -> GlobalId
$cnegate :: GlobalId -> GlobalId
* :: GlobalId -> GlobalId -> GlobalId
$c* :: GlobalId -> GlobalId -> GlobalId
- :: GlobalId -> GlobalId -> GlobalId
$c- :: GlobalId -> GlobalId -> GlobalId
+ :: GlobalId -> GlobalId -> GlobalId
$c+ :: GlobalId -> GlobalId -> GlobalId
Num, (forall x. GlobalId -> Rep GlobalId x)
-> (forall x. Rep GlobalId x -> GlobalId) -> Generic GlobalId
forall x. Rep GlobalId x -> GlobalId
forall x. GlobalId -> Rep GlobalId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalId x -> GlobalId
$cfrom :: forall x. GlobalId -> Rep GlobalId x
Generic, Int -> GlobalId -> ShowS
[GlobalId] -> ShowS
GlobalId -> String
(Int -> GlobalId -> ShowS)
-> (GlobalId -> String) -> ([GlobalId] -> ShowS) -> Show GlobalId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalId] -> ShowS
$cshowList :: [GlobalId] -> ShowS
show :: GlobalId -> String
$cshow :: GlobalId -> String
showsPrec :: Int -> GlobalId -> ShowS
$cshowsPrec :: Int -> GlobalId -> ShowS
Show, Value -> Parser [GlobalId]
Value -> Parser GlobalId
(Value -> Parser GlobalId)
-> (Value -> Parser [GlobalId]) -> FromJSON GlobalId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GlobalId]
$cparseJSONList :: Value -> Parser [GlobalId]
parseJSON :: Value -> Parser GlobalId
$cparseJSON :: Value -> Parser GlobalId
FromJSON, [GlobalId] -> Encoding
[GlobalId] -> Value
GlobalId -> Encoding
GlobalId -> Value
(GlobalId -> Value)
-> (GlobalId -> Encoding)
-> ([GlobalId] -> Value)
-> ([GlobalId] -> Encoding)
-> ToJSON GlobalId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GlobalId] -> Encoding
$ctoEncodingList :: [GlobalId] -> Encoding
toJSONList :: [GlobalId] -> Value
$ctoJSONList :: [GlobalId] -> Value
toEncoding :: GlobalId -> Encoding
$ctoEncoding :: GlobalId -> Encoding
toJSON :: GlobalId -> Value
$ctoJSON :: GlobalId -> Value
ToJSON, FromJSONKeyFunction [GlobalId]
FromJSONKeyFunction GlobalId
FromJSONKeyFunction GlobalId
-> FromJSONKeyFunction [GlobalId] -> FromJSONKey GlobalId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [GlobalId]
$cfromJSONKeyList :: FromJSONKeyFunction [GlobalId]
fromJSONKey :: FromJSONKeyFunction GlobalId
$cfromJSONKey :: FromJSONKeyFunction GlobalId
FromJSONKey, ToJSONKeyFunction [GlobalId]
ToJSONKeyFunction GlobalId
ToJSONKeyFunction GlobalId
-> ToJSONKeyFunction [GlobalId] -> ToJSONKey GlobalId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [GlobalId]
$ctoJSONKeyList :: ToJSONKeyFunction [GlobalId]
toJSONKey :: ToJSONKeyFunction GlobalId
$ctoJSONKey :: ToJSONKeyFunction GlobalId
ToJSONKey)


-- | A locally indexed identifier.
newtype LocalId = LocalId { LocalId -> Int
unLocalId :: Int }
  deriving (Eq LocalId
Eq LocalId
-> (LocalId -> LocalId -> Ordering)
-> (LocalId -> LocalId -> Bool)
-> (LocalId -> LocalId -> Bool)
-> (LocalId -> LocalId -> Bool)
-> (LocalId -> LocalId -> Bool)
-> (LocalId -> LocalId -> LocalId)
-> (LocalId -> LocalId -> LocalId)
-> Ord LocalId
LocalId -> LocalId -> Bool
LocalId -> LocalId -> Ordering
LocalId -> LocalId -> LocalId
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 :: LocalId -> LocalId -> LocalId
$cmin :: LocalId -> LocalId -> LocalId
max :: LocalId -> LocalId -> LocalId
$cmax :: LocalId -> LocalId -> LocalId
>= :: LocalId -> LocalId -> Bool
$c>= :: LocalId -> LocalId -> Bool
> :: LocalId -> LocalId -> Bool
$c> :: LocalId -> LocalId -> Bool
<= :: LocalId -> LocalId -> Bool
$c<= :: LocalId -> LocalId -> Bool
< :: LocalId -> LocalId -> Bool
$c< :: LocalId -> LocalId -> Bool
compare :: LocalId -> LocalId -> Ordering
$ccompare :: LocalId -> LocalId -> Ordering
$cp1Ord :: Eq LocalId
Ord, LocalId -> LocalId -> Bool
(LocalId -> LocalId -> Bool)
-> (LocalId -> LocalId -> Bool) -> Eq LocalId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocalId -> LocalId -> Bool
$c/= :: LocalId -> LocalId -> Bool
== :: LocalId -> LocalId -> Bool
$c== :: LocalId -> LocalId -> Bool
Eq, Int -> LocalId
LocalId -> Int
LocalId -> [LocalId]
LocalId -> LocalId
LocalId -> LocalId -> [LocalId]
LocalId -> LocalId -> LocalId -> [LocalId]
(LocalId -> LocalId)
-> (LocalId -> LocalId)
-> (Int -> LocalId)
-> (LocalId -> Int)
-> (LocalId -> [LocalId])
-> (LocalId -> LocalId -> [LocalId])
-> (LocalId -> LocalId -> [LocalId])
-> (LocalId -> LocalId -> LocalId -> [LocalId])
-> Enum LocalId
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 :: LocalId -> LocalId -> LocalId -> [LocalId]
$cenumFromThenTo :: LocalId -> LocalId -> LocalId -> [LocalId]
enumFromTo :: LocalId -> LocalId -> [LocalId]
$cenumFromTo :: LocalId -> LocalId -> [LocalId]
enumFromThen :: LocalId -> LocalId -> [LocalId]
$cenumFromThen :: LocalId -> LocalId -> [LocalId]
enumFrom :: LocalId -> [LocalId]
$cenumFrom :: LocalId -> [LocalId]
fromEnum :: LocalId -> Int
$cfromEnum :: LocalId -> Int
toEnum :: Int -> LocalId
$ctoEnum :: Int -> LocalId
pred :: LocalId -> LocalId
$cpred :: LocalId -> LocalId
succ :: LocalId -> LocalId
$csucc :: LocalId -> LocalId
Enum, Integer -> LocalId
LocalId -> LocalId
LocalId -> LocalId -> LocalId
(LocalId -> LocalId -> LocalId)
-> (LocalId -> LocalId -> LocalId)
-> (LocalId -> LocalId -> LocalId)
-> (LocalId -> LocalId)
-> (LocalId -> LocalId)
-> (LocalId -> LocalId)
-> (Integer -> LocalId)
-> Num LocalId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> LocalId
$cfromInteger :: Integer -> LocalId
signum :: LocalId -> LocalId
$csignum :: LocalId -> LocalId
abs :: LocalId -> LocalId
$cabs :: LocalId -> LocalId
negate :: LocalId -> LocalId
$cnegate :: LocalId -> LocalId
* :: LocalId -> LocalId -> LocalId
$c* :: LocalId -> LocalId -> LocalId
- :: LocalId -> LocalId -> LocalId
$c- :: LocalId -> LocalId -> LocalId
+ :: LocalId -> LocalId -> LocalId
$c+ :: LocalId -> LocalId -> LocalId
Num, (forall x. LocalId -> Rep LocalId x)
-> (forall x. Rep LocalId x -> LocalId) -> Generic LocalId
forall x. Rep LocalId x -> LocalId
forall x. LocalId -> Rep LocalId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocalId x -> LocalId
$cfrom :: forall x. LocalId -> Rep LocalId x
Generic, Int -> LocalId -> ShowS
[LocalId] -> ShowS
LocalId -> String
(Int -> LocalId -> ShowS)
-> (LocalId -> String) -> ([LocalId] -> ShowS) -> Show LocalId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocalId] -> ShowS
$cshowList :: [LocalId] -> ShowS
show :: LocalId -> String
$cshow :: LocalId -> String
showsPrec :: Int -> LocalId -> ShowS
$cshowsPrec :: Int -> LocalId -> ShowS
Show, Value -> Parser [LocalId]
Value -> Parser LocalId
(Value -> Parser LocalId)
-> (Value -> Parser [LocalId]) -> FromJSON LocalId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LocalId]
$cparseJSONList :: Value -> Parser [LocalId]
parseJSON :: Value -> Parser LocalId
$cparseJSON :: Value -> Parser LocalId
FromJSON, [LocalId] -> Encoding
[LocalId] -> Value
LocalId -> Encoding
LocalId -> Value
(LocalId -> Value)
-> (LocalId -> Encoding)
-> ([LocalId] -> Value)
-> ([LocalId] -> Encoding)
-> ToJSON LocalId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LocalId] -> Encoding
$ctoEncodingList :: [LocalId] -> Encoding
toJSONList :: [LocalId] -> Value
$ctoJSONList :: [LocalId] -> Value
toEncoding :: LocalId -> Encoding
$ctoEncoding :: LocalId -> Encoding
toJSON :: LocalId -> Value
$ctoJSON :: LocalId -> Value
ToJSON, FromJSONKeyFunction [LocalId]
FromJSONKeyFunction LocalId
FromJSONKeyFunction LocalId
-> FromJSONKeyFunction [LocalId] -> FromJSONKey LocalId
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
fromJSONKeyList :: FromJSONKeyFunction [LocalId]
$cfromJSONKeyList :: FromJSONKeyFunction [LocalId]
fromJSONKey :: FromJSONKeyFunction LocalId
$cfromJSONKey :: FromJSONKeyFunction LocalId
FromJSONKey, ToJSONKeyFunction [LocalId]
ToJSONKeyFunction LocalId
ToJSONKeyFunction LocalId
-> ToJSONKeyFunction [LocalId] -> ToJSONKey LocalId
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
toJSONKeyList :: ToJSONKeyFunction [LocalId]
$ctoJSONKeyList :: ToJSONKeyFunction [LocalId]
toJSONKey :: ToJSONKeyFunction LocalId
$ctoJSONKey :: ToJSONKeyFunction LocalId
ToJSONKey)


data XYPair a = XYPair a a

instance FromJSON a => FromJSON (XYPair a) where
  parseJSON :: Value -> Parser (XYPair a)
parseJSON (A.Object Object
o) =
    a -> a -> XYPair a
forall a. a -> a -> XYPair a
XYPair (a -> a -> XYPair a) -> Parser a -> Parser (a -> XYPair a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
           Parser (a -> XYPair a) -> Parser a -> Parser (XYPair a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
  parseJSON Value
invalid = String -> Value -> Parser (XYPair a)
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
invalid

instance ToJSON a => ToJSON (XYPair a) where
  toJSON :: XYPair a -> Value
toJSON (XYPair a
x a
y) =
    [Pair] -> Value
object [ Key
"x" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
x
           , Key
"y" Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= a
y
           ]

fromXYPair :: XYPair a -> (a, a)
fromXYPair :: XYPair a -> (a, a)
fromXYPair (XYPair a
x a
y) = (a
x, a
y)

toXYPair :: (a, a) -> XYPair a
toXYPair :: (a, a) -> XYPair a
toXYPair (a
x, a
y) = a -> a -> XYPair a
forall a. a -> a -> XYPair a
XYPair a
x a
y

omitNulls :: Value -> Value
omitNulls :: Value -> Value
omitNulls (A.Object Object
hs) = Object -> Value
A.Object
                        (Object -> Value) -> ([Pair] -> Object) -> [Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Object
forall l. IsList l => [Item l] -> l
fromList
                        ([Pair] -> Object) -> ([Pair] -> [Pair]) -> [Pair] -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
                        ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Object -> [Item Object]
forall l. IsList l => l -> [Item l]
toList Object
hs
omitNulls Value
x = Value
x

#if MIN_VERSION_aeson(2,0,0)
parseDefault :: FromJSON a => A.Object -> A.Key -> a -> Parser a
#else
parseDefault :: FromJSON a => A.Object -> Text -> a -> Parser a
#endif
parseDefault :: Object -> Key -> a -> Parser a
parseDefault Object
o Key
s a
d = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
d (Maybe a -> a) -> Parser (Maybe a) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
s


data Object = Object { Object -> Int
objectId         :: Int
                       -- ^ Incremental id - unique across all objects
                     , Object -> Double
objectWidth      :: Double
                       -- ^ Width in pixels. Ignored if using a gid.
                     , Object -> Double
objectHeight     :: Double
                       -- ^ Height in pixels. Ignored if using a gid.
                     , Object -> Text
objectName       :: Text
                       -- ^ String assigned to name field in editor
                     , Object -> Text
objectType       :: Text
                       -- ^ String assigned to type field in editor
                     , Object -> Map Text Text
objectProperties :: Map Text Text
                       -- ^ String key-value pairs
                     , Object -> Bool
objectVisible    :: Bool
                       -- ^ Whether object is shown in editor.
                     , Object -> Double
objectX          :: Double
                       -- ^ x coordinate in pixels
                     , Object -> Double
objectY          :: Double
                       -- ^ y coordinate in pixels
                     , Object -> Float
objectRotation   :: Float
                       -- ^ Angle in degrees clockwise
                     , Object -> Maybe GlobalId
objectGid        :: Maybe GlobalId
                       -- ^ GID, only if object comes from a Tilemap
                     , Object -> Bool
objectEllipse    :: Bool
                       -- ^ Used to mark an object as an ellipse
                     , Object -> Maybe (Vector (Double, Double))
objectPolygon    :: Maybe (Vector (Double, Double))
                       -- ^ A list of x,y coordinates in pixels
                     , Object -> Maybe (Vector (Double, Double))
objectPolyline   :: Maybe (Vector (Double, Double))
                       -- ^ A list of x,y coordinates in pixels
                     , Object -> Map Text Text
objectText       :: Map Text Text
                       -- ^ String key-value pairs
                     } deriving (Object -> Object -> Bool
(Object -> Object -> Bool)
-> (Object -> Object -> Bool) -> Eq Object
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c== :: Object -> Object -> Bool
Eq, (forall x. Object -> Rep Object x)
-> (forall x. Rep Object x -> Object) -> Generic Object
forall x. Rep Object x -> Object
forall x. Object -> Rep Object x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Object x -> Object
$cfrom :: forall x. Object -> Rep Object x
Generic, Int -> Object -> ShowS
[Object] -> ShowS
Object -> String
(Int -> Object -> ShowS)
-> (Object -> String) -> ([Object] -> ShowS) -> Show Object
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> String
$cshow :: Object -> String
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Show)

instance FromJSON Object where
  parseJSON :: Value -> Parser Object
parseJSON (A.Object Object
o) = Int
-> Double
-> Double
-> Text
-> Text
-> Map Text Text
-> Bool
-> Double
-> Double
-> Float
-> Maybe GlobalId
-> Bool
-> Maybe (Vector (Double, Double))
-> Maybe (Vector (Double, Double))
-> Map Text Text
-> Object
Object (Int
 -> Double
 -> Double
 -> Text
 -> Text
 -> Map Text Text
 -> Bool
 -> Double
 -> Double
 -> Float
 -> Maybe GlobalId
 -> Bool
 -> Maybe (Vector (Double, Double))
 -> Maybe (Vector (Double, Double))
 -> Map Text Text
 -> Object)
-> Parser Int
-> Parser
     (Double
      -> Double
      -> Text
      -> Text
      -> Map Text Text
      -> Bool
      -> Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
                                  Parser
  (Double
   -> Double
   -> Text
   -> Text
   -> Map Text Text
   -> Bool
   -> Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Double
-> Parser
     (Double
      -> Text
      -> Text
      -> Map Text Text
      -> Bool
      -> Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
                                  Parser
  (Double
   -> Text
   -> Text
   -> Map Text Text
   -> Bool
   -> Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Double
-> Parser
     (Text
      -> Text
      -> Map Text Text
      -> Bool
      -> Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
                                  Parser
  (Text
   -> Text
   -> Map Text Text
   -> Bool
   -> Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Text
-> Parser
     (Text
      -> Map Text Text
      -> Bool
      -> Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                  Parser
  (Text
   -> Map Text Text
   -> Bool
   -> Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Text
-> Parser
     (Map Text Text
      -> Bool
      -> Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                                  Parser
  (Map Text Text
   -> Bool
   -> Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser (Map Text Text)
-> Parser
     (Bool
      -> Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Map Text Text -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> a -> Parser a
parseDefault Object
o Key
"properties" Map Text Text
forall k a. Map k a
M.empty
                                  Parser
  (Bool
   -> Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Bool
-> Parser
     (Double
      -> Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"visible"
                                  Parser
  (Double
   -> Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Double
-> Parser
     (Double
      -> Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
                                  Parser
  (Double
   -> Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Double
-> Parser
     (Float
      -> Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
                                  Parser
  (Float
   -> Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Float
-> Parser
     (Maybe GlobalId
      -> Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rotation"
                                  Parser
  (Maybe GlobalId
   -> Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser (Maybe GlobalId)
-> Parser
     (Bool
      -> Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double))
      -> Map Text Text
      -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe GlobalId)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"gid"
                                  Parser
  (Bool
   -> Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double))
   -> Map Text Text
   -> Object)
-> Parser Bool
-> Parser
     (Maybe (Vector (Double, Double))
      -> Maybe (Vector (Double, Double)) -> Map Text Text -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Bool -> Parser Bool
forall a. FromJSON a => Object -> Key -> a -> Parser a
parseDefault Object
o Key
"ellipse" Bool
False
                                  Parser
  (Maybe (Vector (Double, Double))
   -> Maybe (Vector (Double, Double)) -> Map Text Text -> Object)
-> Parser (Maybe (Vector (Double, Double)))
-> Parser
     (Maybe (Vector (Double, Double)) -> Map Text Text -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe (Vector (XYPair Double)) -> Maybe (Vector (Double, Double)))
-> Parser (Maybe (Vector (XYPair Double)))
-> Parser (Maybe (Vector (Double, Double)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (Vector (XYPair Double))
  -> Maybe (Vector (Double, Double)))
 -> Parser (Maybe (Vector (XYPair Double)))
 -> Parser (Maybe (Vector (Double, Double))))
-> ((XYPair Double -> (Double, Double))
    -> Maybe (Vector (XYPair Double))
    -> Maybe (Vector (Double, Double)))
-> (XYPair Double -> (Double, Double))
-> Parser (Maybe (Vector (XYPair Double)))
-> Parser (Maybe (Vector (Double, Double)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (XYPair Double) -> Vector (Double, Double))
-> Maybe (Vector (XYPair Double))
-> Maybe (Vector (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector (XYPair Double) -> Vector (Double, Double))
 -> Maybe (Vector (XYPair Double))
 -> Maybe (Vector (Double, Double)))
-> ((XYPair Double -> (Double, Double))
    -> Vector (XYPair Double) -> Vector (Double, Double))
-> (XYPair Double -> (Double, Double))
-> Maybe (Vector (XYPair Double))
-> Maybe (Vector (Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XYPair Double -> (Double, Double))
-> Vector (XYPair Double) -> Vector (Double, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) XYPair Double -> (Double, Double)
forall a. XYPair a -> (a, a)
fromXYPair (Object
o Object -> Key -> Parser (Maybe (Vector (XYPair Double)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"polygon")
                                  Parser (Maybe (Vector (Double, Double)) -> Map Text Text -> Object)
-> Parser (Maybe (Vector (Double, Double)))
-> Parser (Map Text Text -> Object)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Maybe (Vector (XYPair Double)) -> Maybe (Vector (Double, Double)))
-> Parser (Maybe (Vector (XYPair Double)))
-> Parser (Maybe (Vector (Double, Double)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (Vector (XYPair Double))
  -> Maybe (Vector (Double, Double)))
 -> Parser (Maybe (Vector (XYPair Double)))
 -> Parser (Maybe (Vector (Double, Double))))
-> ((XYPair Double -> (Double, Double))
    -> Maybe (Vector (XYPair Double))
    -> Maybe (Vector (Double, Double)))
-> (XYPair Double -> (Double, Double))
-> Parser (Maybe (Vector (XYPair Double)))
-> Parser (Maybe (Vector (Double, Double)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector (XYPair Double) -> Vector (Double, Double))
-> Maybe (Vector (XYPair Double))
-> Maybe (Vector (Double, Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector (XYPair Double) -> Vector (Double, Double))
 -> Maybe (Vector (XYPair Double))
 -> Maybe (Vector (Double, Double)))
-> ((XYPair Double -> (Double, Double))
    -> Vector (XYPair Double) -> Vector (Double, Double))
-> (XYPair Double -> (Double, Double))
-> Maybe (Vector (XYPair Double))
-> Maybe (Vector (Double, Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XYPair Double -> (Double, Double))
-> Vector (XYPair Double) -> Vector (Double, Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) XYPair Double -> (Double, Double)
forall a. XYPair a -> (a, a)
fromXYPair (Object
o Object -> Key -> Parser (Maybe (Vector (XYPair Double)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"polyline")
                                  Parser (Map Text Text -> Object)
-> Parser (Map Text Text) -> Parser Object
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Key -> Map Text Text -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> a -> Parser a
parseDefault Object
o Key
"text" Map Text Text
forall k a. Map k a
M.empty
  parseJSON Value
invalid = String -> Value -> Parser Object
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
invalid

instance ToJSON Object where
  toJSON :: Object -> Value
toJSON Object{Bool
Double
Float
Int
Maybe (Vector (Double, Double))
Maybe GlobalId
Text
Map Text Text
objectText :: Map Text Text
objectPolyline :: Maybe (Vector (Double, Double))
objectPolygon :: Maybe (Vector (Double, Double))
objectEllipse :: Bool
objectGid :: Maybe GlobalId
objectRotation :: Float
objectY :: Double
objectX :: Double
objectVisible :: Bool
objectProperties :: Map Text Text
objectType :: Text
objectName :: Text
objectHeight :: Double
objectWidth :: Double
objectId :: Int
objectText :: Object -> Map Text Text
objectPolyline :: Object -> Maybe (Vector (Double, Double))
objectPolygon :: Object -> Maybe (Vector (Double, Double))
objectEllipse :: Object -> Bool
objectGid :: Object -> Maybe GlobalId
objectRotation :: Object -> Float
objectY :: Object -> Double
objectX :: Object -> Double
objectVisible :: Object -> Bool
objectProperties :: Object -> Map Text Text
objectType :: Object -> Text
objectName :: Object -> Text
objectHeight :: Object -> Double
objectWidth :: Object -> Double
objectId :: Object -> Int
..} = Value -> Value
omitNulls (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$
    [Pair] -> Value
object [ Key
"id"         Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
objectId
           , Key
"width"      Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
objectWidth
           , Key
"height"     Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
objectHeight
           , Key
"name"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
objectName
           , Key
"type"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
objectType
           , Key
"properties" Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
objectProperties
           , Key
"visible"    Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
objectVisible
           , Key
"x"          Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
objectX
           , Key
"y"          Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
objectY
           , Key
"rotation"   Key -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Float
objectRotation
           , Key
"gid"        Key -> Maybe GlobalId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe GlobalId
objectGid
           , Key
"ellipse"    Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
objectEllipse
           , Key
"polygon"    Key -> Maybe (Vector (XYPair Double)) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ((Vector (Double, Double) -> Vector (XYPair Double))
-> Maybe (Vector (Double, Double))
-> Maybe (Vector (XYPair Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector (Double, Double) -> Vector (XYPair Double))
 -> Maybe (Vector (Double, Double))
 -> Maybe (Vector (XYPair Double)))
-> (((Double, Double) -> XYPair Double)
    -> Vector (Double, Double) -> Vector (XYPair Double))
-> ((Double, Double) -> XYPair Double)
-> Maybe (Vector (Double, Double))
-> Maybe (Vector (XYPair Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Double) -> XYPair Double)
-> Vector (Double, Double) -> Vector (XYPair Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Double, Double) -> XYPair Double
forall a. (a, a) -> XYPair a
toXYPair Maybe (Vector (Double, Double))
objectPolygon
           , Key
"polyline"   Key -> Maybe (Vector (XYPair Double)) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ((Vector (Double, Double) -> Vector (XYPair Double))
-> Maybe (Vector (Double, Double))
-> Maybe (Vector (XYPair Double))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Vector (Double, Double) -> Vector (XYPair Double))
 -> Maybe (Vector (Double, Double))
 -> Maybe (Vector (XYPair Double)))
-> (((Double, Double) -> XYPair Double)
    -> Vector (Double, Double) -> Vector (XYPair Double))
-> ((Double, Double) -> XYPair Double)
-> Maybe (Vector (Double, Double))
-> Maybe (Vector (XYPair Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Double) -> XYPair Double)
-> Vector (Double, Double) -> Vector (XYPair Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Double, Double) -> XYPair Double
forall a. (a, a) -> XYPair a
toXYPair Maybe (Vector (Double, Double))
objectPolyline
           , Key
"text"       Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
objectText
           ]


data Layer = Layer { Layer -> Double
layerWidth      :: Double
                     -- ^ Column count. Same as map width for fixed-size maps.
                   , Layer -> Double
layerHeight     :: Double
                     -- ^ Row count. Same as map height for fixed-size maps.
                   , Layer -> Text
layerName       :: Text
                     -- ^ Name assigned to this layer
                   , Layer -> Text
layerType       :: Text -- TODO: LayerType
                     -- ^ “tilelayer”, “objectgroup”, or “imagelayer”
                   , Layer -> Bool
layerVisible    :: Bool
                     -- ^ Whether layer is shown or hidden in editor
                   , Layer -> Double
layerX          :: Double
                     -- ^ Horizontal layer offset in tiles. Always 0.
                   , Layer -> Double
layerY          :: Double
                     -- ^ Vertical layer offset in tiles. Always 0.
                   , Layer -> Maybe (Vector GlobalId)
layerData       :: Maybe (Vector GlobalId)
                     -- ^ Array of GIDs. tilelayer only.
                   , Layer -> Maybe (Vector Object)
layerObjects    :: Maybe (Vector Object)
                     -- ^ Array of Objects. objectgroup only.
                   , Layer -> Map Text Text
layerProperties :: Map Text Text
                     -- ^ string key-value pairs.
                   , Layer -> Float
layerOpacity    :: Float
                     -- ^ Value between 0 and 1
                   , Layer -> Text
layerDraworder  :: Text -- TODO: DrawOrder
                     -- ^ “topdown” (default) or “index”. objectgroup only.
                   } deriving (Layer -> Layer -> Bool
(Layer -> Layer -> Bool) -> (Layer -> Layer -> Bool) -> Eq Layer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Layer -> Layer -> Bool
$c/= :: Layer -> Layer -> Bool
== :: Layer -> Layer -> Bool
$c== :: Layer -> Layer -> Bool
Eq, (forall x. Layer -> Rep Layer x)
-> (forall x. Rep Layer x -> Layer) -> Generic Layer
forall x. Rep Layer x -> Layer
forall x. Layer -> Rep Layer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Layer x -> Layer
$cfrom :: forall x. Layer -> Rep Layer x
Generic, Int -> Layer -> ShowS
[Layer] -> ShowS
Layer -> String
(Int -> Layer -> ShowS)
-> (Layer -> String) -> ([Layer] -> ShowS) -> Show Layer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Layer] -> ShowS
$cshowList :: [Layer] -> ShowS
show :: Layer -> String
$cshow :: Layer -> String
showsPrec :: Int -> Layer -> ShowS
$cshowsPrec :: Int -> Layer -> ShowS
Show)

instance FromJSON Layer where
  parseJSON :: Value -> Parser Layer
parseJSON (A.Object Object
o) = Double
-> Double
-> Text
-> Text
-> Bool
-> Double
-> Double
-> Maybe (Vector GlobalId)
-> Maybe (Vector Object)
-> Map Text Text
-> Float
-> Text
-> Layer
Layer (Double
 -> Double
 -> Text
 -> Text
 -> Bool
 -> Double
 -> Double
 -> Maybe (Vector GlobalId)
 -> Maybe (Vector Object)
 -> Map Text Text
 -> Float
 -> Text
 -> Layer)
-> Parser Double
-> Parser
     (Double
      -> Text
      -> Text
      -> Bool
      -> Double
      -> Double
      -> Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"      Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0)
                                 Parser
  (Double
   -> Text
   -> Text
   -> Bool
   -> Double
   -> Double
   -> Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser Double
-> Parser
     (Text
      -> Text
      -> Bool
      -> Double
      -> Double
      -> Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"     Parser Double -> Parser Double -> Parser Double
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Double -> Parser Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0)
                                 Parser
  (Text
   -> Text
   -> Bool
   -> Double
   -> Double
   -> Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Double
      -> Double
      -> Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                 Parser
  (Text
   -> Bool
   -> Double
   -> Double
   -> Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser Text
-> Parser
     (Bool
      -> Double
      -> Double
      -> Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                                 Parser
  (Bool
   -> Double
   -> Double
   -> Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser Bool
-> Parser
     (Double
      -> Double
      -> Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"visible"
                                 Parser
  (Double
   -> Double
   -> Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser Double
-> Parser
     (Double
      -> Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
                                 Parser
  (Double
   -> Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser Double
-> Parser
     (Maybe (Vector GlobalId)
      -> Maybe (Vector Object)
      -> Map Text Text
      -> Float
      -> Text
      -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
                                 Parser
  (Maybe (Vector GlobalId)
   -> Maybe (Vector Object)
   -> Map Text Text
   -> Float
   -> Text
   -> Layer)
-> Parser (Maybe (Vector GlobalId))
-> Parser
     (Maybe (Vector Object) -> Map Text Text -> Float -> Text -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Vector GlobalId))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"       Parser (Maybe (Vector GlobalId))
-> Parser (Maybe (Vector GlobalId))
-> Parser (Maybe (Vector GlobalId))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Vector GlobalId) -> Parser (Maybe (Vector GlobalId))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Vector GlobalId)
forall a. Maybe a
Nothing)
                                 Parser
  (Maybe (Vector Object) -> Map Text Text -> Float -> Text -> Layer)
-> Parser (Maybe (Vector Object))
-> Parser (Map Text Text -> Float -> Text -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Vector Object))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"objects"
                                 Parser (Map Text Text -> Float -> Text -> Layer)
-> Parser (Map Text Text) -> Parser (Float -> Text -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"properties" Parser (Map Text Text)
-> Parser (Map Text Text) -> Parser (Map Text Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Text -> Parser (Map Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Text
forall a. Monoid a => a
mempty)
                                 Parser (Float -> Text -> Layer)
-> Parser Float -> Parser (Text -> Layer)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"opacity"
                                 Parser (Text -> Layer) -> Parser Text -> Parser Layer
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"draworder"  Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"topdown")
  parseJSON Value
invalid = String -> Value -> Parser Layer
forall a. String -> Value -> Parser a
typeMismatch String
"Layer" Value
invalid

instance ToJSON Layer where
  toJSON :: Layer -> Value
toJSON Layer{Bool
Double
Float
Maybe (Vector Object)
Maybe (Vector GlobalId)
Text
Map Text Text
layerDraworder :: Text
layerOpacity :: Float
layerProperties :: Map Text Text
layerObjects :: Maybe (Vector Object)
layerData :: Maybe (Vector GlobalId)
layerY :: Double
layerX :: Double
layerVisible :: Bool
layerType :: Text
layerName :: Text
layerHeight :: Double
layerWidth :: Double
layerDraworder :: Layer -> Text
layerOpacity :: Layer -> Float
layerProperties :: Layer -> Map Text Text
layerObjects :: Layer -> Maybe (Vector Object)
layerData :: Layer -> Maybe (Vector GlobalId)
layerY :: Layer -> Double
layerX :: Layer -> Double
layerVisible :: Layer -> Bool
layerType :: Layer -> Text
layerName :: Layer -> Text
layerHeight :: Layer -> Double
layerWidth :: Layer -> Double
..} = Value -> Value
omitNulls (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$
    [Pair] -> Value
object [ Key
"width"      Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
layerWidth
           , Key
"height"     Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
layerHeight
           , Key
"name"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
layerName
           , Key
"type"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
layerType
           , Key
"visible"    Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
layerVisible
           , Key
"x"          Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
layerX
           , Key
"y"          Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
layerY
           , Key
"data"       Key -> Maybe (Vector GlobalId) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector GlobalId)
layerData
           , Key
"objects"    Key -> Maybe (Vector Object) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector Object)
layerObjects
           , Key
"properties" Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
layerProperties
           , Key
"opacity"    Key -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Float
layerOpacity
           , Key
"draworder"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
layerDraworder
           ]


data Terrain = Terrain { Terrain -> Text
terrainName :: Text
                         -- ^ Name of terrain
                       , Terrain -> LocalId
terrainTile :: LocalId
                         -- ^ Local ID of tile representing terrain
                       } deriving (Terrain -> Terrain -> Bool
(Terrain -> Terrain -> Bool)
-> (Terrain -> Terrain -> Bool) -> Eq Terrain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Terrain -> Terrain -> Bool
$c/= :: Terrain -> Terrain -> Bool
== :: Terrain -> Terrain -> Bool
$c== :: Terrain -> Terrain -> Bool
Eq, (forall x. Terrain -> Rep Terrain x)
-> (forall x. Rep Terrain x -> Terrain) -> Generic Terrain
forall x. Rep Terrain x -> Terrain
forall x. Terrain -> Rep Terrain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Terrain x -> Terrain
$cfrom :: forall x. Terrain -> Rep Terrain x
Generic, Int -> Terrain -> ShowS
[Terrain] -> ShowS
Terrain -> String
(Int -> Terrain -> ShowS)
-> (Terrain -> String) -> ([Terrain] -> ShowS) -> Show Terrain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Terrain] -> ShowS
$cshowList :: [Terrain] -> ShowS
show :: Terrain -> String
$cshow :: Terrain -> String
showsPrec :: Int -> Terrain -> ShowS
$cshowsPrec :: Int -> Terrain -> ShowS
Show)

instance FromJSON Terrain where
  parseJSON :: Value -> Parser Terrain
parseJSON (A.Object Object
o) = Text -> LocalId -> Terrain
Terrain (Text -> LocalId -> Terrain)
-> Parser Text -> Parser (LocalId -> Terrain)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                   Parser (LocalId -> Terrain) -> Parser LocalId -> Parser Terrain
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LocalId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tile"
  parseJSON Value
invalid = String -> Value -> Parser Terrain
forall a. String -> Value -> Parser a
typeMismatch String
"Terrain" Value
invalid

instance ToJSON Terrain where
  toJSON :: Terrain -> Value
toJSON Terrain{Text
LocalId
terrainTile :: LocalId
terrainName :: Text
terrainTile :: Terrain -> LocalId
terrainName :: Terrain -> Text
..} = [Pair] -> Value
object [ Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
terrainName
                              , Key
"tile" Key -> LocalId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LocalId
terrainTile
                              ]



data Frame = Frame { Frame -> Int
frameDuration :: Int
                   , Frame -> LocalId
frameTileId   :: LocalId
                   } deriving (Frame -> Frame -> Bool
(Frame -> Frame -> Bool) -> (Frame -> Frame -> Bool) -> Eq Frame
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c== :: Frame -> Frame -> Bool
Eq, (forall x. Frame -> Rep Frame x)
-> (forall x. Rep Frame x -> Frame) -> Generic Frame
forall x. Rep Frame x -> Frame
forall x. Frame -> Rep Frame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Frame x -> Frame
$cfrom :: forall x. Frame -> Rep Frame x
Generic, Int -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
(Int -> Frame -> ShowS)
-> (Frame -> String) -> ([Frame] -> ShowS) -> Show Frame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: Int -> Frame -> ShowS
$cshowsPrec :: Int -> Frame -> ShowS
Show)

instance FromJSON Frame where
  parseJSON :: Value -> Parser Frame
parseJSON (A.Object Object
o) = Int -> LocalId -> Frame
Frame (Int -> LocalId -> Frame)
-> Parser Int -> Parser (LocalId -> Frame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
                                 Parser (LocalId -> Frame) -> Parser LocalId -> Parser Frame
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser LocalId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tileid"
  parseJSON Value
invalid = String -> Value -> Parser Frame
forall a. String -> Value -> Parser a
typeMismatch String
"Frame" Value
invalid

instance ToJSON Frame where
  toJSON :: Frame -> Value
toJSON Frame{Int
LocalId
frameTileId :: LocalId
frameDuration :: Int
frameTileId :: Frame -> LocalId
frameDuration :: Frame -> Int
..} = [Pair] -> Value
object [ Key
"duration" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
frameDuration
                            , Key
"tileid"   Key -> LocalId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LocalId
frameTileId
                            ]


data Tile = Tile { Tile -> LocalId
tileId          :: LocalId
                 , Tile -> Map Text Text
tileProperties  :: Map Text Text
                 , Tile -> Maybe Value
tileImage       :: Maybe Value
                 , Tile -> Maybe (Vector Object)
tileObjectGroup :: Maybe (Vector Object)
                 , Tile -> Maybe (Vector Frame)
tileAnimation   :: Maybe (Vector Frame)
                 } deriving (Tile -> Tile -> Bool
(Tile -> Tile -> Bool) -> (Tile -> Tile -> Bool) -> Eq Tile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tile -> Tile -> Bool
$c/= :: Tile -> Tile -> Bool
== :: Tile -> Tile -> Bool
$c== :: Tile -> Tile -> Bool
Eq, (forall x. Tile -> Rep Tile x)
-> (forall x. Rep Tile x -> Tile) -> Generic Tile
forall x. Rep Tile x -> Tile
forall x. Tile -> Rep Tile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tile x -> Tile
$cfrom :: forall x. Tile -> Rep Tile x
Generic, Int -> Tile -> ShowS
[Tile] -> ShowS
Tile -> String
(Int -> Tile -> ShowS)
-> (Tile -> String) -> ([Tile] -> ShowS) -> Show Tile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tile] -> ShowS
$cshowList :: [Tile] -> ShowS
show :: Tile -> String
$cshow :: Tile -> String
showsPrec :: Int -> Tile -> ShowS
$cshowsPrec :: Int -> Tile -> ShowS
Show)

instance FromJSON Tile where
  parseJSON :: Value -> Parser Tile
parseJSON (A.Object Object
o) = LocalId
-> Map Text Text
-> Maybe Value
-> Maybe (Vector Object)
-> Maybe (Vector Frame)
-> Tile
Tile LocalId
0 (Map Text Text
 -> Maybe Value
 -> Maybe (Vector Object)
 -> Maybe (Vector Frame)
 -> Tile)
-> Parser (Map Text Text)
-> Parser
     (Maybe Value
      -> Maybe (Vector Object) -> Maybe (Vector Frame) -> Tile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"properties"  Parser (Map Text Text)
-> Parser (Map Text Text) -> Parser (Map Text Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Text -> Parser (Map Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Text
forall a. Monoid a => a
mempty)
                                  Parser
  (Maybe Value
   -> Maybe (Vector Object) -> Maybe (Vector Frame) -> Tile)
-> Parser (Maybe Value)
-> Parser (Maybe (Vector Object) -> Maybe (Vector Frame) -> Tile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image"       Parser (Maybe Value)
-> Parser (Maybe Value) -> Parser (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Value -> Parser (Maybe Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Value
forall a. Maybe a
Nothing)
                                  Parser (Maybe (Vector Object) -> Maybe (Vector Frame) -> Tile)
-> Parser (Maybe (Vector Object))
-> Parser (Maybe (Vector Frame) -> Tile)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Vector Object))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"objectGroup" Parser (Maybe (Vector Object))
-> Parser (Maybe (Vector Object)) -> Parser (Maybe (Vector Object))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Vector Object) -> Parser (Maybe (Vector Object))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Vector Object)
forall a. Monoid a => a
mempty)
                                  Parser (Maybe (Vector Frame) -> Tile)
-> Parser (Maybe (Vector Frame)) -> Parser Tile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Vector Frame))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"animation"   Parser (Maybe (Vector Frame))
-> Parser (Maybe (Vector Frame)) -> Parser (Maybe (Vector Frame))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Vector Frame) -> Parser (Maybe (Vector Frame))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Vector Frame)
forall a. Monoid a => a
mempty)
  parseJSON Value
invalid = String -> Value -> Parser Tile
forall a. String -> Value -> Parser a
typeMismatch String
"Tile" Value
invalid

instance ToJSON Tile where
  toJSON :: Tile -> Value
toJSON Tile{Maybe Value
Maybe (Vector Frame)
Maybe (Vector Object)
Map Text Text
LocalId
tileAnimation :: Maybe (Vector Frame)
tileObjectGroup :: Maybe (Vector Object)
tileImage :: Maybe Value
tileProperties :: Map Text Text
tileId :: LocalId
tileAnimation :: Tile -> Maybe (Vector Frame)
tileObjectGroup :: Tile -> Maybe (Vector Object)
tileImage :: Tile -> Maybe Value
tileProperties :: Tile -> Map Text Text
tileId :: Tile -> LocalId
..} = [Pair] -> Value
object [ Key
"properties"   Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
tileProperties
                           , Key
"image"        Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
tileImage
                           , Key
"objectGroup"  Key -> Maybe (Vector Object) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector Object)
tileObjectGroup
                           , Key
"animation"    Key -> Maybe (Vector Frame) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector Frame)
tileAnimation
                           ]


data Tileset = Tileset { Tileset -> GlobalId
tilesetFirstgid       :: GlobalId
                         -- ^ GID corresponding to the first tile in the set
                       , Tileset -> String
tilesetImage          :: FilePath
                         -- ^ Image used for tiles in this set
                       , Tileset -> Text
tilesetName           :: Text
                         -- ^ Name given to this tileset
                       , Tileset -> Int
tilesetTilewidth      :: Int
                         -- ^ Maximum width of tiles in this set
                       , Tileset -> Int
tilesetTileheight     :: Int
                         -- ^ Maximum height of tiles in this set
                       , Tileset -> Int
tilesetImagewidth     :: Int
                         -- ^ Width of source image in pixels
                       , Tileset -> Int
tilesetImageheight    :: Int
                         -- ^ Height of source image in pixels
                       , Tileset -> Map Text Text
tilesetProperties     :: Map Text Text
                         -- ^ String key-value pairs
                       , Tileset -> Map Text Text
tilesetPropertytypes  :: Map Text Text
                         -- ^ String key-value pairs
                       , Tileset -> Int
tilesetMargin         :: Int
                         -- ^ Buffer between image edge and first tile (pixels)
                       , Tileset -> Int
tilesetSpacing        :: Int
                         -- ^ Spacing between adjacent tiles in image (pixels)
                       , Tileset -> Map GlobalId (Map Text Text)
tilesetTileproperties :: Map GlobalId (Map Text Text)
                         -- ^ Per-tile properties, indexed by gid as string
                       , Tileset -> Vector Terrain
tilesetTerrains       :: Vector Terrain
                         -- ^ Array of Terrains (optional)
                       , Tileset -> Int
tilesetColumns        :: Int
                         -- ^ The number of tile columns in the tileset
                       , Tileset -> Int
tilesetTilecount      :: Int
                         -- ^ The number of tiles in this tileset
                       , Tileset -> Map LocalId Tile
tilesetTiles          :: Map LocalId Tile
                         -- ^ Tiles (optional)
                       } deriving (Tileset -> Tileset -> Bool
(Tileset -> Tileset -> Bool)
-> (Tileset -> Tileset -> Bool) -> Eq Tileset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tileset -> Tileset -> Bool
$c/= :: Tileset -> Tileset -> Bool
== :: Tileset -> Tileset -> Bool
$c== :: Tileset -> Tileset -> Bool
Eq, (forall x. Tileset -> Rep Tileset x)
-> (forall x. Rep Tileset x -> Tileset) -> Generic Tileset
forall x. Rep Tileset x -> Tileset
forall x. Tileset -> Rep Tileset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tileset x -> Tileset
$cfrom :: forall x. Tileset -> Rep Tileset x
Generic, Int -> Tileset -> ShowS
[Tileset] -> ShowS
Tileset -> String
(Int -> Tileset -> ShowS)
-> (Tileset -> String) -> ([Tileset] -> ShowS) -> Show Tileset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tileset] -> ShowS
$cshowList :: [Tileset] -> ShowS
show :: Tileset -> String
$cshow :: Tileset -> String
showsPrec :: Int -> Tileset -> ShowS
$cshowsPrec :: Int -> Tileset -> ShowS
Show)

newtype TransitiveTilesetMap = TransitiveTilesetMap (Map LocalId Value)
  deriving (Int -> TransitiveTilesetMap -> ShowS
[TransitiveTilesetMap] -> ShowS
TransitiveTilesetMap -> String
(Int -> TransitiveTilesetMap -> ShowS)
-> (TransitiveTilesetMap -> String)
-> ([TransitiveTilesetMap] -> ShowS)
-> Show TransitiveTilesetMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransitiveTilesetMap] -> ShowS
$cshowList :: [TransitiveTilesetMap] -> ShowS
show :: TransitiveTilesetMap -> String
$cshow :: TransitiveTilesetMap -> String
showsPrec :: Int -> TransitiveTilesetMap -> ShowS
$cshowsPrec :: Int -> TransitiveTilesetMap -> ShowS
Show, TransitiveTilesetMap -> TransitiveTilesetMap -> Bool
(TransitiveTilesetMap -> TransitiveTilesetMap -> Bool)
-> (TransitiveTilesetMap -> TransitiveTilesetMap -> Bool)
-> Eq TransitiveTilesetMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransitiveTilesetMap -> TransitiveTilesetMap -> Bool
$c/= :: TransitiveTilesetMap -> TransitiveTilesetMap -> Bool
== :: TransitiveTilesetMap -> TransitiveTilesetMap -> Bool
$c== :: TransitiveTilesetMap -> TransitiveTilesetMap -> Bool
Eq, (forall x. TransitiveTilesetMap -> Rep TransitiveTilesetMap x)
-> (forall x. Rep TransitiveTilesetMap x -> TransitiveTilesetMap)
-> Generic TransitiveTilesetMap
forall x. Rep TransitiveTilesetMap x -> TransitiveTilesetMap
forall x. TransitiveTilesetMap -> Rep TransitiveTilesetMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransitiveTilesetMap x -> TransitiveTilesetMap
$cfrom :: forall x. TransitiveTilesetMap -> Rep TransitiveTilesetMap x
Generic, Value -> Parser [TransitiveTilesetMap]
Value -> Parser TransitiveTilesetMap
(Value -> Parser TransitiveTilesetMap)
-> (Value -> Parser [TransitiveTilesetMap])
-> FromJSON TransitiveTilesetMap
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TransitiveTilesetMap]
$cparseJSONList :: Value -> Parser [TransitiveTilesetMap]
parseJSON :: Value -> Parser TransitiveTilesetMap
$cparseJSON :: Value -> Parser TransitiveTilesetMap
FromJSON)

parseTiles :: A.Object -> Parser (Map LocalId Tile)
parseTiles :: Object -> Parser (Map LocalId Tile)
parseTiles Object
o = do
  TransitiveTilesetMap Map LocalId Value
localId2Value <- Object
o Object -> Key -> Parser TransitiveTilesetMap
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tiles"
  [(LocalId, Tile)]
localIdAndTiles <- [(LocalId, Value)]
-> ((LocalId, Value) -> Parser (LocalId, Tile))
-> Parser [(LocalId, Tile)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map LocalId Value -> [(LocalId, Value)]
forall k a. Map k a -> [(k, a)]
M.toList Map LocalId Value
localId2Value) (((LocalId, Value) -> Parser (LocalId, Tile))
 -> Parser [(LocalId, Tile)])
-> ((LocalId, Value) -> Parser (LocalId, Tile))
-> Parser [(LocalId, Tile)]
forall a b. (a -> b) -> a -> b
$ \(LocalId
lid, Value
val) -> do
    Tile
tile <- Value -> Parser Tile
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
    (LocalId, Tile) -> Parser (LocalId, Tile)
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalId
lid, Tile
tile{ tileId :: LocalId
tileId = LocalId
lid })
  Map LocalId Tile -> Parser (Map LocalId Tile)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map LocalId Tile -> Parser (Map LocalId Tile))
-> Map LocalId Tile -> Parser (Map LocalId Tile)
forall a b. (a -> b) -> a -> b
$ [(LocalId, Tile)] -> Map LocalId Tile
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(LocalId, Tile)]
localIdAndTiles

instance FromJSON Tileset where
  parseJSON :: Value -> Parser Tileset
parseJSON (A.Object Object
o) = GlobalId
-> String
-> Text
-> Int
-> Int
-> Int
-> Int
-> Map Text Text
-> Map Text Text
-> Int
-> Int
-> Map GlobalId (Map Text Text)
-> Vector Terrain
-> Int
-> Int
-> Map LocalId Tile
-> Tileset
Tileset (GlobalId
 -> String
 -> Text
 -> Int
 -> Int
 -> Int
 -> Int
 -> Map Text Text
 -> Map Text Text
 -> Int
 -> Int
 -> Map GlobalId (Map Text Text)
 -> Vector Terrain
 -> Int
 -> Int
 -> Map LocalId Tile
 -> Tileset)
-> Parser GlobalId
-> Parser
     (String
      -> Text
      -> Int
      -> Int
      -> Int
      -> Int
      -> Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Object
o Object -> Key -> Parser GlobalId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"firstgid"
                                   Parser
  (String
   -> Text
   -> Int
   -> Int
   -> Int
   -> Int
   -> Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser String
-> Parser
     (Text
      -> Int
      -> Int
      -> Int
      -> Int
      -> Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"image"
                                   Parser
  (Text
   -> Int
   -> Int
   -> Int
   -> Int
   -> Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Text
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                   Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tilewidth"
                                   Parser
  (Int
   -> Int
   -> Int
   -> Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tileheight"
                                   Parser
  (Int
   -> Int
   -> Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Int
-> Parser
     (Int
      -> Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"imagewidth"
                                   Parser
  (Int
   -> Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Int
-> Parser
     (Map Text Text
      -> Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"imageheight"
                                   Parser
  (Map Text Text
   -> Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser (Map Text Text)
-> Parser
     (Map Text Text
      -> Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"properties"     Parser (Map Text Text)
-> Parser (Map Text Text) -> Parser (Map Text Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Text -> Parser (Map Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Text
forall a. Monoid a => a
mempty)
                                   Parser
  (Map Text Text
   -> Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser (Map Text Text)
-> Parser
     (Int
      -> Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"propertytypes"  Parser (Map Text Text)
-> Parser (Map Text Text) -> Parser (Map Text Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Text -> Parser (Map Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Text
forall a. Monoid a => a
mempty)
                                   Parser
  (Int
   -> Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Int
-> Parser
     (Int
      -> Map GlobalId (Map Text Text)
      -> Vector Terrain
      -> Int
      -> Int
      -> Map LocalId Tile
      -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"margin"
                                   Parser
  (Int
   -> Map GlobalId (Map Text Text)
   -> Vector Terrain
   -> Int
   -> Int
   -> Map LocalId Tile
   -> Tileset)
-> Parser Int
-> Parser
     (Map GlobalId (Map Text Text)
      -> Vector Terrain -> Int -> Int -> Map LocalId Tile -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"spacing"
                                   Parser
  (Map GlobalId (Map Text Text)
   -> Vector Terrain -> Int -> Int -> Map LocalId Tile -> Tileset)
-> Parser (Map GlobalId (Map Text Text))
-> Parser
     (Vector Terrain -> Int -> Int -> Map LocalId Tile -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map GlobalId (Map Text Text))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tileproperties" Parser (Map GlobalId (Map Text Text))
-> Parser (Map GlobalId (Map Text Text))
-> Parser (Map GlobalId (Map Text Text))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map GlobalId (Map Text Text)
-> Parser (Map GlobalId (Map Text Text))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map GlobalId (Map Text Text)
forall a. Monoid a => a
mempty)
                                   Parser
  (Vector Terrain -> Int -> Int -> Map LocalId Tile -> Tileset)
-> Parser (Vector Terrain)
-> Parser (Int -> Int -> Map LocalId Tile -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Vector Terrain)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"terrains"       Parser (Vector Terrain)
-> Parser (Vector Terrain) -> Parser (Vector Terrain)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Vector Terrain -> Parser (Vector Terrain)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector Terrain
forall a. Monoid a => a
mempty)
                                   Parser (Int -> Int -> Map LocalId Tile -> Tileset)
-> Parser Int -> Parser (Int -> Map LocalId Tile -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns"
                                   Parser (Int -> Map LocalId Tile -> Tileset)
-> Parser Int -> Parser (Map LocalId Tile -> Tileset)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tilecount"
                                   Parser (Map LocalId Tile -> Tileset)
-> Parser (Map LocalId Tile) -> Parser Tileset
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object -> Parser (Map LocalId Tile)
parseTiles Object
o          Parser (Map LocalId Tile)
-> Parser (Map LocalId Tile) -> Parser (Map LocalId Tile)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map LocalId Tile -> Parser (Map LocalId Tile)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map LocalId Tile
forall a. Monoid a => a
mempty)
  parseJSON Value
invalid = String -> Value -> Parser Tileset
forall a. String -> Value -> Parser a
typeMismatch String
"Tileset" Value
invalid

instance ToJSON Tileset where
  toJSON :: Tileset -> Value
toJSON Tileset{Int
String
Text
Map Text Text
Map LocalId Tile
Map GlobalId (Map Text Text)
Vector Terrain
GlobalId
tilesetTiles :: Map LocalId Tile
tilesetTilecount :: Int
tilesetColumns :: Int
tilesetTerrains :: Vector Terrain
tilesetTileproperties :: Map GlobalId (Map Text Text)
tilesetSpacing :: Int
tilesetMargin :: Int
tilesetPropertytypes :: Map Text Text
tilesetProperties :: Map Text Text
tilesetImageheight :: Int
tilesetImagewidth :: Int
tilesetTileheight :: Int
tilesetTilewidth :: Int
tilesetName :: Text
tilesetImage :: String
tilesetFirstgid :: GlobalId
tilesetTiles :: Tileset -> Map LocalId Tile
tilesetTilecount :: Tileset -> Int
tilesetColumns :: Tileset -> Int
tilesetTerrains :: Tileset -> Vector Terrain
tilesetTileproperties :: Tileset -> Map GlobalId (Map Text Text)
tilesetSpacing :: Tileset -> Int
tilesetMargin :: Tileset -> Int
tilesetPropertytypes :: Tileset -> Map Text Text
tilesetProperties :: Tileset -> Map Text Text
tilesetImageheight :: Tileset -> Int
tilesetImagewidth :: Tileset -> Int
tilesetTileheight :: Tileset -> Int
tilesetTilewidth :: Tileset -> Int
tilesetName :: Tileset -> Text
tilesetImage :: Tileset -> String
tilesetFirstgid :: Tileset -> GlobalId
..} = [Pair] -> Value
object [ Key
"firstgid"       Key -> GlobalId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GlobalId
tilesetFirstgid
                              , Key
"image"          Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
tilesetImage
                              , Key
"name"           Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
tilesetName
                              , Key
"tilewidth"      Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetTilewidth
                              , Key
"tileheight"     Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetTileheight
                              , Key
"imagewidth"     Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetImagewidth
                              , Key
"imageheight"    Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetImageheight
                              , Key
"properties"     Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
tilesetProperties
                              , Key
"propertytypes"  Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
tilesetPropertytypes
                              , Key
"margin"         Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetMargin
                              , Key
"spacing"        Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetSpacing
                              , Key
"tileproperties" Key -> Map GlobalId (Map Text Text) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map GlobalId (Map Text Text)
tilesetTileproperties
                              , Key
"terrains"       Key -> Vector Terrain -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Terrain
tilesetTerrains
                              , Key
"columns"        Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetColumns
                              , Key
"tilecount"      Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tilesetTilecount
                              , Key
"tiles"          Key -> Map LocalId Tile -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map LocalId Tile
tilesetTiles
                              ]

data Version
  = VersionFloat Float
  | VersionText Text
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Eq Version
Eq Version
-> (Version -> Version -> Ordering)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Bool)
-> (Version -> Version -> Version)
-> (Version -> Version -> Version)
-> Ord Version
Version -> Version -> Bool
Version -> Version -> Ordering
Version -> Version -> Version
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 :: Version -> Version -> Version
$cmin :: Version -> Version -> Version
max :: Version -> Version -> Version
$cmax :: Version -> Version -> Version
>= :: Version -> Version -> Bool
$c>= :: Version -> Version -> Bool
> :: Version -> Version -> Bool
$c> :: Version -> Version -> Bool
<= :: Version -> Version -> Bool
$c<= :: Version -> Version -> Bool
< :: Version -> Version -> Bool
$c< :: Version -> Version -> Bool
compare :: Version -> Version -> Ordering
$ccompare :: Version -> Version -> Ordering
$cp1Ord :: Eq Version
Ord, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, (forall x. Version -> Rep Version x)
-> (forall x. Rep Version x -> Version) -> Generic Version
forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic)

instance FromJSON Version where
  parseJSON :: Value -> Parser Version
parseJSON Value
v =
    (Float -> Version) -> Parser Float -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Float -> Version
VersionFloat (Value -> Parser Float
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v) Parser Version -> Parser Version -> Parser Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Text -> Version) -> Parser Text -> Parser Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Version
VersionText (Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v)

instance ToJSON Version where
  toJSON :: Version -> Value
toJSON Version
version = case Version
version of
    VersionFloat Float
f -> Float -> Value
forall a. ToJSON a => a -> Value
toJSON Float
f
    VersionText Text
t  -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t

data Orientation
  = Orthogonal
  | Isometric
  | Staggered
  | Orientation Text
  deriving (Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, Eq Orientation
Eq Orientation
-> (Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
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 :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmax :: Orientation -> Orientation -> Orientation
>= :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c< :: Orientation -> Orientation -> Bool
compare :: Orientation -> Orientation -> Ordering
$ccompare :: Orientation -> Orientation -> Ordering
$cp1Ord :: Eq Orientation
Ord, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> Orientation -> ShowS
Show, (forall x. Orientation -> Rep Orientation x)
-> (forall x. Rep Orientation x -> Orientation)
-> Generic Orientation
forall x. Rep Orientation x -> Orientation
forall x. Orientation -> Rep Orientation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Orientation x -> Orientation
$cfrom :: forall x. Orientation -> Rep Orientation x
Generic)

instance FromJSON Orientation where
  parseJSON :: Value -> Parser Orientation
parseJSON = String
-> (Text -> Parser Orientation) -> Value -> Parser Orientation
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Orientation" ((Text -> Parser Orientation) -> Value -> Parser Orientation)
-> (Text -> Parser Orientation) -> Value -> Parser Orientation
forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text
t of
      Text
"orthogonal" -> Orientation -> Parser Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Orthogonal
      Text
"isometric"  -> Orientation -> Parser Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Isometric
      Text
"staggered"  -> Orientation -> Parser Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Orientation
Staggered
      Text
_otherwise   -> Orientation -> Parser Orientation
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Orientation -> Parser Orientation)
-> Orientation -> Parser Orientation
forall a b. (a -> b) -> a -> b
$ Text -> Orientation
Orientation Text
t

instance ToJSON Orientation where
  toJSON :: Orientation -> Value
toJSON Orientation
o = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case Orientation
o of
    Orientation
Orthogonal    -> Text
"orthogonal"
    Orientation
Isometric     -> Text
"isometric"
    Orientation
Staggered     -> Text
"staggered"
    Orientation Text
t -> Text
t

-- | The full monty.
data Tiledmap = Tiledmap { Tiledmap -> Version
tiledmapVersion         :: Version
                           -- ^ The JSON format version
                         , Tiledmap -> Version
tiledmapTiledversion    :: Version
                           -- ^ The Tiled version used to save the file
                         , Tiledmap -> Int
tiledmapWidth           :: Int
                           -- ^ Number of tile columns
                         , Tiledmap -> Int
tiledmapHeight          :: Int
                           -- ^ Number of tile rows
                         , Tiledmap -> Double
tiledmapTilewidth       :: Double
                           -- ^ Map grid width.
                         , Tiledmap -> Double
tiledmapTileheight      :: Double
                           -- ^ Map grid height.
                         , Tiledmap -> Orientation
tiledmapOrientation     :: Orientation
                           -- ^ Orthogonal, isometric, or staggered
                         , Tiledmap -> Vector Layer
tiledmapLayers          :: Vector Layer
                           -- ^ Array of Layers
                         , Tiledmap -> Vector Tileset
tiledmapTilesets        :: Vector Tileset
                           -- ^ Array of Tilesets
                         , Tiledmap -> Maybe Text
tiledmapBackgroundcolor :: Maybe Text
                           -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)
                         , Tiledmap -> Text
tiledmapRenderorder     :: Text -- TODO: RenderOrder
                           -- ^ Rendering direction (orthogonal maps only)
                         , Tiledmap -> Map Text Text
tiledmapProperties      :: Map Text Text
                           -- ^ String key-value pairs
                         , Tiledmap -> Int
tiledmapNextobjectid    :: Int
                           -- ^ Auto-increments for each placed object
                         } deriving (Tiledmap -> Tiledmap -> Bool
(Tiledmap -> Tiledmap -> Bool)
-> (Tiledmap -> Tiledmap -> Bool) -> Eq Tiledmap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tiledmap -> Tiledmap -> Bool
$c/= :: Tiledmap -> Tiledmap -> Bool
== :: Tiledmap -> Tiledmap -> Bool
$c== :: Tiledmap -> Tiledmap -> Bool
Eq, (forall x. Tiledmap -> Rep Tiledmap x)
-> (forall x. Rep Tiledmap x -> Tiledmap) -> Generic Tiledmap
forall x. Rep Tiledmap x -> Tiledmap
forall x. Tiledmap -> Rep Tiledmap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tiledmap x -> Tiledmap
$cfrom :: forall x. Tiledmap -> Rep Tiledmap x
Generic, Int -> Tiledmap -> ShowS
[Tiledmap] -> ShowS
Tiledmap -> String
(Int -> Tiledmap -> ShowS)
-> (Tiledmap -> String) -> ([Tiledmap] -> ShowS) -> Show Tiledmap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tiledmap] -> ShowS
$cshowList :: [Tiledmap] -> ShowS
show :: Tiledmap -> String
$cshow :: Tiledmap -> String
showsPrec :: Int -> Tiledmap -> ShowS
$cshowsPrec :: Int -> Tiledmap -> ShowS
Show)

instance FromJSON Tiledmap where
  parseJSON :: Value -> Parser Tiledmap
parseJSON (A.Object Object
o) = Version
-> Version
-> Int
-> Int
-> Double
-> Double
-> Orientation
-> Vector Layer
-> Vector Tileset
-> Maybe Text
-> Text
-> Map Text Text
-> Int
-> Tiledmap
Tiledmap (Version
 -> Version
 -> Int
 -> Int
 -> Double
 -> Double
 -> Orientation
 -> Vector Layer
 -> Vector Tileset
 -> Maybe Text
 -> Text
 -> Map Text Text
 -> Int
 -> Tiledmap)
-> Parser Version
-> Parser
     (Version
      -> Int
      -> Int
      -> Double
      -> Double
      -> Orientation
      -> Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Object
o Object -> Key -> Parser Version
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
                                    Parser
  (Version
   -> Int
   -> Int
   -> Double
   -> Double
   -> Orientation
   -> Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser Version
-> Parser
     (Int
      -> Int
      -> Double
      -> Double
      -> Orientation
      -> Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Version
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tiledversion"
                                    Parser
  (Int
   -> Int
   -> Double
   -> Double
   -> Orientation
   -> Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser Int
-> Parser
     (Int
      -> Double
      -> Double
      -> Orientation
      -> Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
                                    Parser
  (Int
   -> Double
   -> Double
   -> Orientation
   -> Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser Int
-> Parser
     (Double
      -> Double
      -> Orientation
      -> Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
                                    Parser
  (Double
   -> Double
   -> Orientation
   -> Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser Double
-> Parser
     (Double
      -> Orientation
      -> Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tilewidth"
                                    Parser
  (Double
   -> Orientation
   -> Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser Double
-> Parser
     (Orientation
      -> Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tileheight"
                                    Parser
  (Orientation
   -> Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser Orientation
-> Parser
     (Vector Layer
      -> Vector Tileset
      -> Maybe Text
      -> Text
      -> Map Text Text
      -> Int
      -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Orientation
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"orientation"
                                    Parser
  (Vector Layer
   -> Vector Tileset
   -> Maybe Text
   -> Text
   -> Map Text Text
   -> Int
   -> Tiledmap)
-> Parser (Vector Layer)
-> Parser
     (Vector Tileset
      -> Maybe Text -> Text -> Map Text Text -> Int -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser (Vector Layer)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"layers"
                                    Parser
  (Vector Tileset
   -> Maybe Text -> Text -> Map Text Text -> Int -> Tiledmap)
-> Parser (Vector Tileset)
-> Parser (Maybe Text -> Text -> Map Text Text -> Int -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser (Vector Tileset)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tilesets"
                                    Parser (Maybe Text -> Text -> Map Text Text -> Int -> Tiledmap)
-> Parser (Maybe Text)
-> Parser (Text -> Map Text Text -> Int -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"backgroundcolor" Parser (Maybe Text) -> Parser (Maybe Text) -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing)
                                    Parser (Text -> Map Text Text -> Int -> Tiledmap)
-> Parser Text -> Parser (Map Text Text -> Int -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"renderorder"
                                    Parser (Map Text Text -> Int -> Tiledmap)
-> Parser (Map Text Text) -> Parser (Int -> Tiledmap)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map Text Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"properties"      Parser (Map Text Text)
-> Parser (Map Text Text) -> Parser (Map Text Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text Text -> Parser (Map Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Text
forall a. Monoid a => a
mempty)
                                    Parser (Int -> Tiledmap) -> Parser Int -> Parser Tiledmap
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nextobjectid"
  parseJSON Value
invalid = String -> Value -> Parser Tiledmap
forall a. String -> Value -> Parser a
typeMismatch String
"Tiledmap" Value
invalid

instance ToJSON Tiledmap where
  toJSON :: Tiledmap -> Value
toJSON Tiledmap{Double
Int
Maybe Text
Text
Map Text Text
Vector Tileset
Vector Layer
Orientation
Version
tiledmapNextobjectid :: Int
tiledmapProperties :: Map Text Text
tiledmapRenderorder :: Text
tiledmapBackgroundcolor :: Maybe Text
tiledmapTilesets :: Vector Tileset
tiledmapLayers :: Vector Layer
tiledmapOrientation :: Orientation
tiledmapTileheight :: Double
tiledmapTilewidth :: Double
tiledmapHeight :: Int
tiledmapWidth :: Int
tiledmapTiledversion :: Version
tiledmapVersion :: Version
tiledmapNextobjectid :: Tiledmap -> Int
tiledmapProperties :: Tiledmap -> Map Text Text
tiledmapRenderorder :: Tiledmap -> Text
tiledmapBackgroundcolor :: Tiledmap -> Maybe Text
tiledmapTilesets :: Tiledmap -> Vector Tileset
tiledmapLayers :: Tiledmap -> Vector Layer
tiledmapOrientation :: Tiledmap -> Orientation
tiledmapTileheight :: Tiledmap -> Double
tiledmapTilewidth :: Tiledmap -> Double
tiledmapHeight :: Tiledmap -> Int
tiledmapWidth :: Tiledmap -> Int
tiledmapTiledversion :: Tiledmap -> Version
tiledmapVersion :: Tiledmap -> Version
..} = [Pair] -> Value
object [ Key
"version"         Key -> Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Version
tiledmapVersion
                               , Key
"tiledversion"    Key -> Version -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Version
tiledmapTiledversion
                               , Key
"width"           Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tiledmapWidth
                               , Key
"height"          Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tiledmapHeight
                               , Key
"tilewidth"       Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
tiledmapTilewidth
                               , Key
"tileheight"      Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
tiledmapTileheight
                               , Key
"orientation"     Key -> Orientation -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Orientation
tiledmapOrientation
                               , Key
"layers"          Key -> Vector Layer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Layer
tiledmapLayers
                               , Key
"tilesets"        Key -> Vector Tileset -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector Tileset
tiledmapTilesets
                               , Key
"backgroundcolor" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
tiledmapBackgroundcolor
                               , Key
"renderorder"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
tiledmapRenderorder
                               , Key
"properties"      Key -> Map Text Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text Text
tiledmapProperties
                               , Key
"nextobjectid"    Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
tiledmapNextobjectid
                               ]


-- | Load a Tiled map from the given 'FilePath'.
loadTiledmap :: FilePath -> IO (Either String Tiledmap)
loadTiledmap :: String -> IO (Either String Tiledmap)
loadTiledmap = (ByteString -> Either String Tiledmap)
-> IO ByteString -> IO (Either String Tiledmap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either String Tiledmap
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (IO ByteString -> IO (Either String Tiledmap))
-> (String -> IO ByteString)
-> String
-> IO (Either String Tiledmap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
C8.readFile