module Codec.Tiled.Tileset.Ref where

import Control.Applicative ((<|>))
import Data.Aeson (FromJSON(..), ToJSON(..), (.:), (.=))
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson qualified as Aeson
import GHC.Generics (Generic)

import Codec.Tiled.Tileset (Tileset)
import Data.Tiled.GID (GID)

data TilesetRef
  = TilesetRef
      { TilesetRef -> GID
firstGid :: GID      -- ^ GID corresponding to the first tile in the set
      , TilesetRef -> FilePath
source   :: FilePath -- ^ The external file that contains this tilesets data
      }
  | TilesetEmbedded
      { firstGid :: GID
      , TilesetRef -> Tileset
embedded :: Tileset
      }
  deriving (TilesetRef -> TilesetRef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TilesetRef -> TilesetRef -> Bool
$c/= :: TilesetRef -> TilesetRef -> Bool
== :: TilesetRef -> TilesetRef -> Bool
$c== :: TilesetRef -> TilesetRef -> Bool
Eq, Int -> TilesetRef -> ShowS
[TilesetRef] -> ShowS
TilesetRef -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TilesetRef] -> ShowS
$cshowList :: [TilesetRef] -> ShowS
show :: TilesetRef -> FilePath
$cshow :: TilesetRef -> FilePath
showsPrec :: Int -> TilesetRef -> ShowS
$cshowsPrec :: Int -> TilesetRef -> ShowS
Show, forall x. Rep TilesetRef x -> TilesetRef
forall x. TilesetRef -> Rep TilesetRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TilesetRef x -> TilesetRef
$cfrom :: forall x. TilesetRef -> Rep TilesetRef x
Generic)

instance FromJSON TilesetRef where
  parseJSON :: Value -> Parser TilesetRef
parseJSON Value
v = Value -> Parser TilesetRef
refP Value
v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser TilesetRef
embeddedP Value
v
    where
      refP :: Value -> Parser TilesetRef
refP = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"TilesetRef" \Object
o -> do
        FilePath
source <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
        GID
firstGid <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"firstgid"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure TilesetRef{FilePath
GID
firstGid :: GID
source :: FilePath
source :: FilePath
firstGid :: GID
..}

      embeddedP :: Value -> Parser TilesetRef
embeddedP = forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject FilePath
"TilesetEmbedded" \Object
o -> do
        Tileset
embedded <- forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Aeson.Object Object
o)
        GID
firstGid <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"firstgid"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure TilesetEmbedded{GID
Tileset
firstGid :: GID
embedded :: Tileset
embedded :: Tileset
firstGid :: GID
..}

instance ToJSON TilesetRef where
  toJSON :: TilesetRef -> Value
toJSON = \case
    TilesetRef{FilePath
GID
source :: FilePath
firstGid :: GID
source :: TilesetRef -> FilePath
firstGid :: TilesetRef -> GID
..} -> [Pair] -> Value
Aeson.object
      [ Key
"firstgid" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= GID
firstGid
      , Key
"source"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
source
      ]
    TilesetEmbedded{GID
Tileset
embedded :: Tileset
firstGid :: GID
embedded :: TilesetRef -> Tileset
firstGid :: TilesetRef -> GID
..} ->
      case forall a. ToJSON a => a -> Value
toJSON Tileset
embedded of
        Aeson.Object Object
o ->
          Object -> Value
Aeson.Object forall a b. (a -> b) -> a -> b
$
            forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
"firstgid" (forall a. ToJSON a => a -> Value
toJSON GID
firstGid) Object
o
        Value
_nonObject ->
          forall a. HasCallStack => FilePath -> a
error FilePath
"assert: TilesetRef is Object"