aeson-tiled 0.0.1.0 → 0.0.2.0

raw patch · 40 files changed

+1178/−536 lines, 40 filesdep +filepathdep +tastydep +tasty-hunitdep −hspecdep −hspec-discoverdep ~aesondep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: filepath, tasty, tasty-hunit, temporary

Dependencies removed: hspec, hspec-discover

Dependency ranges changed: aeson, bytestring

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• README.md +19/−1
• aeson-tiled.cabal +97/−39
• maps/microgue/embedded-zstd.tmj +55/−0
• maps/microgue/external-zstd.tmj +37/−0
• maps/microgue/tiles.tsj +21/−0
• src/Codec/Tiled.hs +44/−0
• src/Codec/Tiled/Aeson.hs +48/−0
• src/Codec/Tiled/Layer.hs +50/−0
• src/Codec/Tiled/Layer/Chunk.hs +21/−0
• src/Codec/Tiled/Layer/Data.hs +32/−0
• src/Codec/Tiled/Map.hs +42/−0
• src/Codec/Tiled/Map/IO.hs +37/−0
• src/Codec/Tiled/Object.hs +38/−0
• src/Codec/Tiled/Object/Point.hs +17/−0
• src/Codec/Tiled/Object/Template.hs +21/−0
• src/Codec/Tiled/Object/Template/IO.hs +37/−0
• src/Codec/Tiled/Object/Text.hs +28/−0
• src/Codec/Tiled/Property.hs +21/−0
• src/Codec/Tiled/Tileset.hs +50/−0
• src/Codec/Tiled/Tileset/Frame.hs +17/−0
• src/Codec/Tiled/Tileset/Grid.hs +19/−0
• src/Codec/Tiled/Tileset/IO.hs +37/−0
• src/Codec/Tiled/Tileset/Ref.hs +48/−0
• src/Codec/Tiled/Tileset/Terrain.hs +21/−0
• src/Codec/Tiled/Tileset/Tile.hs +30/−0
• src/Codec/Tiled/Tileset/TileOffset.hs +17/−0
• src/Codec/Tiled/Tileset/Transformations.hs +19/−0
• src/Codec/Tiled/Tileset/WangColor.hs +23/−0
• src/Codec/Tiled/Tileset/WangSet.hs +26/−0
• src/Codec/Tiled/Tileset/WangTile.hs +18/−0
• src/Codec/Tiled/World.hs +24/−0
• src/Codec/Tiled/World/Map.hs +17/−0
• src/Codec/Tiled/World/Pattern.hs +19/−0
• src/Data/Aeson/Tiled.hs +0/−447
• src/Data/Tiled/GID.hs +64/−0
• test/ParseObjectSpec.hs +0/−22
• test/RoundTripSpec.hs +0/−26
• test/Spec.hs +0/−1
• tests/Main.hs +59/−0

@@ -1,5 +1,9 @@ # Change Log +## [0.0.2.0] - 2022-05-04++Massive rewrite for Tiled 1.8.+ ## [0.0.1.0] - 2022-02-19  Package moved to https://github.com/haskell-game/aeson-tiled@@ -12,5 +16,6 @@  Initial release. +[0.0.2.0]: https://github.com/haskell-game/aeson-tiled/releases/tag/v0.0.2.0 [0.0.1.0]: https://github.com/haskell-game/aeson-tiled/releases/tag/v0.0.1.0 [0.0.0.1]: https://github.com/haskell-game/aeson-tiled/releases/tag/v0.0.0.1

@@ -2,9 +2,27 @@  [![Hackage](https://img.shields.io/hackage/v/aeson-tiled.svg)](https://hackage.haskell.org/package/aeson-tiled) -Types and instances for [Tiled](https://www.mapeditor.org/) map editor `.tmj` files.+Types and instances for [Tiled](https://www.mapeditor.org/) map editor map/`.tmj` and tileset/`.tsj` files.  > `aeson-tiled` is the spiritual successor to `htiled`. > `htiled` uses `hxt` which relies too heavily on Arrows and is rather hard to work with. > Tiled's json export supports 100% of Tiled's features, so there doesn't seem to be much of a point to maintaining a large Arrows-based project when writing Aeson instances for Tiled types is much easier. > Hence this project!++The package is geared toward minimal divergence from Tiled type specifications.++Tiled data format is taken at version 1.8.4.+Should be compatible down to 1.6 (where the `version` field changed to string).++GHC versions are supported from 8.10 and follow Stackage LTS + Stackage Nightly + whatever is available on `ghcup`.++## Module structure++The modules are designed for qualified imports and `OverloadedRecordDot` extension.+Everyone has a `Generic` instance so you can use `generic-lens` or `generic-optics` if you wish.++- Modules under `Codec.Tiled.*` are concerned with `aeson` representation, one type at a time.+  They provide JSON `Value` translation to concrete types, but not much beyond that.+  Your application most likely should use its own representation.+- Modules under `Data.Tiled.*` are types specific to this package.+  They are more refined and may be utilized directly.

@@ -1,33 +1,79 @@-name:                aeson-tiled-version:             0.0.1.0-synopsis:            Aeson instances for the Tiled map editor.-description:         The mighty Tiled 2D map editor is an open source-                     app for creating tile based level maps. This package provides-                     types and aeson instances to read Tiled json files.-homepage:            https://github.com/haskell-game/aeson-tiled-license:             BSD3-license-file:        LICENSE-maintainer:          aenor.realm@gmai.com-author:              Schell Scivally-copyright:           (c) 2017 Schell Scivally-category:            Game Engine-build-type:          Simple-cabal-version:       >=1.10+cabal-version: 3.0+name: aeson-tiled+version: 0.0.2.0+synopsis: Aeson instances for the Tiled map editor.+description:+  The mighty Tiled 2D map editor is an open source+  app for creating tile based level maps. This package provides+  types and aeson instances to read Tiled json files.+homepage: https://github.com/haskell-game/aeson-tiled+license: BSD-3-Clause+license-file: LICENSE+maintainer: aenor.realm@gmai.com+author: Schell Scivally+copyright: (c) 2017 Schell Scivally+category: Game Engine+build-type: Simple  extra-source-files:   README.md,-  ChangeLog.md+  ChangeLog.md,+  maps/microgue/*.tmj,+  maps/microgue/*.tsj  library-  hs-source-dirs:      src-  exposed-modules:     Data.Aeson.Tiled-  build-depends:       base       >= 4.7 && < 5-                     , bytestring >= 0.10 && < 1-                     , aeson      >= 1.0 && < 3-                     , containers >= 0.5 && < 1-                     , text       >= 1.2 && < 3-                     , vector     >= 0.11 && < 1-  default-language:    Haskell2010+  hs-source-dirs: src+  exposed-modules:+    Codec.Tiled+    Codec.Tiled.Aeson+    Codec.Tiled.Layer+    Codec.Tiled.Layer.Chunk+    Codec.Tiled.Layer.Data+    Codec.Tiled.Map+    Codec.Tiled.Map.IO+    Codec.Tiled.Object+    Codec.Tiled.Object.Point+    Codec.Tiled.Object.Template+    Codec.Tiled.Object.Template.IO+    Codec.Tiled.Object.Text+    Codec.Tiled.Property+    Codec.Tiled.Tileset+    Codec.Tiled.Tileset.Frame+    Codec.Tiled.Tileset.Grid+    Codec.Tiled.Tileset.IO+    Codec.Tiled.Tileset.Ref+    Codec.Tiled.Tileset.Terrain+    Codec.Tiled.Tileset.Tile+    Codec.Tiled.Tileset.TileOffset+    Codec.Tiled.Tileset.Transformations+    Codec.Tiled.Tileset.WangColor+    Codec.Tiled.Tileset.WangSet+    Codec.Tiled.Tileset.WangTile+    Codec.Tiled.World+    Codec.Tiled.World.Map+    Codec.Tiled.World.Pattern+    Data.Tiled.GID+  build-depends:+      base       >= 4.7 && < 5+    , bytestring >= 0.10 && < 1+    , aeson      >= 1.0 && < 3+    , containers >= 0.5 && < 1+    , text       >= 1.2 && < 3+    , vector     >= 0.11 && < 1+  default-language:+    Haskell2010+  default-extensions:+    BlockArguments,+    DeriveGeneric,+    DerivingStrategies,+    FlexibleContexts,+    GeneralizedNewtypeDeriving,+    ImportQualifiedPost,+    LambdaCase,+    OverloadedStrings,+    PatternSynonyms,+    RecordWildCards,+    StrictData,  flag tests   manual: True@@ -36,17 +82,29 @@ test-suite aeson-tiled-test   if !flag(tests)     buildable: False-  type:                exitcode-stdio-1.0-  hs-source-dirs:      test-  main-is:             Spec.hs-  build-depends:       base-                     , aeson >= 1.1-                     , aeson-tiled-                     , hspec-                     , hspec-discover-                     , bytestring-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  default-language:    Haskell2010-  other-modules:-    ParseObjectSpec-    RoundTripSpec+  type: exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is: Main.hs+  build-depends:+    aeson-tiled,+    base,+    filepath,+    tasty-hunit,+    tasty,+    temporary++  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-language:+    Haskell2010+  default-extensions:+    BlockArguments,+    DeriveGeneric,+    DerivingStrategies,+    FlexibleContexts,+    GeneralizedNewtypeDeriving,+    ImportQualifiedPost,+    LambdaCase,+    OverloadedStrings,+    PatternSynonyms,+    RecordWildCards,+    StrictData,

@@ -0,0 +1,55 @@+{+  "compressionlevel": -1,+  "height": 16,+  "infinite": false,+  "layers": [+    {+      "compression": "zstd",+      "data": "KLUv\/WAAA7UHAFLJGyiAx5kDM8BblCAjKCIixr341LpkwIWrp5ThlTG\/Azb16VQXuqva\/d9SX1B4AgJABLu2Dygq5PHEHZI7E7D0rAsMPNqQ+7HcFeO9OeaLBqWaXKNA\/BA1nMHRCk7gnK0STW\/3yS3J7ryhZzfAfrnlVz+gkVUK6hS00hqgAqKhowPnELMDPDqeTnZdiCFtpwcaj92HaqMQEyWL8C4PYAS\/6WwedAdUsJ1Kf5JZQBoSHK8Gfb2YO8znYIyMtG2wcWVZDuhdN2SGFwxFcAhnQBoD67xGQ9DVoVGTwbIOUW7f6R9PZts4qG\/nRiWz1iEe6EI1qjh6ag==",+      "encoding": "base64",+      "height": 16,+      "id": 1,+      "name": "Calque de Tuiles 1",+      "opacity": 1,+      "type": "tilelayer",+      "visible": true,+      "width": 16,+      "x": 0,+      "y": 0+    }+  ],+  "nextlayerid": 2,+  "nextobjectid": 1,+  "orientation": "orthogonal",+  "renderorder": "right-down",+  "tiledversion": "1.8.4",+  "tileheight": 8,+  "tilesets": [+    {+      "firstgid": 1,+      "columns": 16,+      "image": "tiles.png",+      "imageheight": 80,+      "imagewidth": 128,+      "margin": 0,+      "name": "microtest",+      "spacing": 0,+      "tilecount": 160,+      "tiledversion": "1.8.4",+      "tileheight": 8,+      "tilewidth": 8,+      "transformations": {+        "hflip": false,+        "preferuntransformed": true,+        "rotate": true,+        "vflip": false+      },+      "type": "tileset",+      "version": "1.8"+    }+  ],+  "tilewidth": 8,+  "type": "map",+  "version": "1.8",+  "width": 16+}

@@ -0,0 +1,37 @@+{+  "compressionlevel": -1,+  "height": 16,+  "infinite": false,+  "layers": [+    {+      "compression": "zstd",+      "data": "KLUv\/WAAA7UHAFLJGyiAx5kDM8BblCAjKCIixr341LpkwIWrp5ThlTG\/Azb16VQXuqva\/d9SX1B4AgJABLu2Dygq5PHEHZI7E7D0rAsMPNqQ+7HcFeO9OeaLBqWaXKNA\/BA1nMHRCk7gnK0STW\/3yS3J7ryhZzfAfrnlVz+gkVUK6hS00hqgAqKhowPnELMDPDqeTnZdiCFtpwcaj92HaqMQEyWL8C4PYAS\/6WwedAdUsJ1Kf5JZQBoSHK8Gfb2YO8znYIyMtG2wcWVZDuhdN2SGFwxFcAhnQBoD67xGQ9DVoVGTwbIOUW7f6R9PZts4qG\/nRiWz1iEe6EI1qjh6ag==",+      "encoding": "base64",+      "height": 16,+      "id": 1,+      "name": "Calque de Tuiles 1",+      "opacity": 1,+      "type": "tilelayer",+      "visible": true,+      "width": 16,+      "x": 0,+      "y": 0+    }+  ],+  "nextlayerid": 2,+  "nextobjectid": 1,+  "orientation": "orthogonal",+  "renderorder": "right-down",+  "tiledversion": "1.8.4",+  "tileheight": 8,+  "tilesets": [+    {+      "firstgid": 1,+      "source": "tiles.tsj"+    }+  ],+  "tilewidth": 8,+  "type": "map",+  "version": "1.8",+  "width": 16+}

@@ -0,0 +1,21 @@+{+  "columns": 16,+  "image": "tiles.png",+  "imageheight": 80,+  "imagewidth": 128,+  "margin": 0,+  "name": "microtest",+  "spacing": 0,+  "tilecount": 160,+  "tiledversion": "1.8.4",+  "tileheight": 8,+  "tilewidth": 8,+  "transformations": {+    "hflip": false,+    "preferuntransformed": true,+    "rotate": true,+    "vflip": false+  },+  "type": "tileset",+  "version": "1.8"+}

@@ -0,0 +1,44 @@+module Codec.Tiled+  ( Chunk+  , Frame+  , Grid+  , Layer+  , LayerData+  , Map+  , Object+  , Point+  , Property+  , Template+  , Terrain+  , Text+  , Tile+  , TileOffset+  , Tileset+  , Transformations+  , WangColor+  , WangSet+  , WangTile++  , GID+  ) where++import Codec.Tiled.Layer (Layer)+import Codec.Tiled.Layer.Chunk (Chunk)+import Codec.Tiled.Layer.Data (LayerData)+import Codec.Tiled.Map (Map)+import Codec.Tiled.Object (Object)+import Codec.Tiled.Object.Point (Point)+import Codec.Tiled.Object.Template (Template)+import Codec.Tiled.Object.Text (Text)+import Codec.Tiled.Property (Property)+import Codec.Tiled.Tileset (Tileset)+import Codec.Tiled.Tileset.Frame (Frame)+import Codec.Tiled.Tileset.Grid (Grid)+import Codec.Tiled.Tileset.Terrain (Terrain)+import Codec.Tiled.Tileset.Tile (Tile)+import Codec.Tiled.Tileset.TileOffset (TileOffset)+import Codec.Tiled.Tileset.Transformations (Transformations)+import Codec.Tiled.Tileset.WangColor (WangColor)+import Codec.Tiled.Tileset.WangSet (WangSet)+import Codec.Tiled.Tileset.WangTile (WangTile)+import Data.Tiled.GID (GID)

@@ -0,0 +1,48 @@+module Codec.Tiled.Aeson+  ( FromJSON(..)+  , ToJSON(..)+  , genericParseJSON+  , genericToJSON+  , mkOptions+  , remapFields+  , remapFields_+  )+  where++import Data.Aeson (FromJSON(..), ToJSON(..))+import Data.Aeson qualified as Aeson+import Data.Aeson.Types (Parser)+import Data.Char (toLower)+import Data.List (dropWhileEnd)+import GHC.Generics (Generic, Rep)++genericParseJSON+  :: ( Generic a+     , Aeson.GFromJSON Aeson.Zero (Rep a)+     )+  => Aeson.Value+  -> Parser a+genericParseJSON = Aeson.genericParseJSON (mkOptions remapFields)++genericToJSON+  :: ( Generic a+     , Aeson.GToJSON' Aeson.Value Aeson.Zero (Rep a)+     )+  => a+  -> Aeson.Value+genericToJSON = Aeson.genericToJSON (mkOptions remapFields)++mkOptions :: (String -> String) -> Aeson.Options+mkOptions fieldMods = Aeson.defaultOptions+  { Aeson.fieldLabelModifier  = fieldMods+  , Aeson.omitNothingFields   = True+  , Aeson.rejectUnknownFields = False+  }++-- | Drop trailing @_@ and convert field names to lowercase.+remapFields :: String -> String+remapFields = remapFields_ . map toLower++-- | Only drop trailing @_@.+remapFields_ :: String -> String+remapFields_ = dropWhileEnd (== '_')

@@ -0,0 +1,50 @@+module Codec.Tiled.Layer where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Layer.Chunk (Chunk)+import Codec.Tiled.Layer.Data (LayerData)+import Codec.Tiled.Object (Object)+import Codec.Tiled.Property (Property)++data Layer = Layer+  { chunks           :: Maybe (Vector Chunk)    -- ^ Array of chunks (optional). tilelayer only.+  , compression      :: Maybe Text              -- ^ @zlib@, @gzip@, @zstd@ or empty (default). tilelayer only.+  , data_            :: Maybe LayerData         -- ^ Array of unsigned int (GIDs) or base64-encoded data. tilelayer only.+  , draworder        :: Maybe Text              -- ^ @topdown@ (default) or @index@. objectgroup only.+  , encoding         :: Maybe Text              -- ^ @csv@ (default) or @base64@. tilelayer only.+  , height           :: Maybe Int               -- ^ Row count. Same as map height for fixed-size maps.+  , id               :: Maybe Int               -- ^ Incremental ID - unique across all layers+  , image            :: Maybe FilePath          -- ^ Image used by this layer. imagelayer only.+  , layers           :: Maybe (Vector Layer)    -- ^ Array of layers. group only.+  , locked           :: Maybe Bool              -- ^ Whether layer is locked in the editor (default: false). (since Tiled 1.8.2)+  , name             :: Text                    -- ^ Name assigned to this layer+  , objects          :: Maybe (Vector Object)   -- ^ Array of objects. objectgroup only.+  , offsetX          :: Maybe Double            -- ^ Horizontal layer offset in pixels (default: 0)+  , offsetY          :: Maybe Double            -- ^ Vertical layer offset in pixels (default: 0)+  , opacity          :: Double                  -- ^ Value between 0 and 1.+  , parallaxX        :: Maybe Double            -- ^ Horizontal parallax factor for this layer (default: 1).+  , parallaxY        :: Maybe Double            -- ^ Vertical parallax factor for this layer (default: 1).+  , properties       :: Maybe (Vector Property) -- ^ Array of Properties+  , repeatX          :: Maybe Bool              -- ^ Whether the image drawn by this layer is repeated along the X axis. imagelayer only.+  , repeatY          :: Maybe Bool              -- ^ Whether the image drawn by this layer is repeated along the Y axis. imagelayer only.+  , startX           :: Maybe Int               -- ^ X coordinate where layer content starts (for infinite maps)+  , startY           :: Maybe Int               -- ^ Y coordinate where layer content starts (for infinite maps)+  , tintColor        :: Maybe Text              -- ^ Hex-formatted tint color (#RRGGBB or #AARRGGBB) that is multiplied with any graphics drawn by this layer or any child layers (optional).+  , transparentColor :: Maybe Text              -- ^ Hex-formatted color (#RRGGBB) (optional). imagelayer only.+  , type_            :: Text                    -- ^ @tilelayer@, @objectgroup@, @imagelayer@ or @group@+  , visible          :: Bool                    -- ^ Whether layer is shown or hidden in editor+  , width            :: Maybe Int               -- ^ Column count. Same as map width for fixed-size maps.+  , x                :: Maybe Int               -- ^ Horizontal layer offset in tiles. Always 0.+  , y                :: Maybe Int               -- ^ Vertical layer offset in tiles. Always 0.+  }+  deriving (Eq, Show, Generic)++instance FromJSON Layer where+  parseJSON = genericParseJSON++instance ToJSON Layer where+  toJSON = genericToJSON

@@ -0,0 +1,21 @@+module Codec.Tiled.Layer.Chunk where++import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Layer.Data (LayerData)++data Chunk = Chunk+  { data_  :: LayerData -- ^ Array of unsigned int (GIDs) or base64-encoded data+  , height :: Int       -- ^ Height in tiles+  , width  :: Int       -- ^ Width in tiles+  , x      :: Int       -- ^ X coordinate in tiles+  , y      :: Int       -- ^ Y coordinate in tiles+  }+  deriving (Eq, Show, Generic)++instance FromJSON Chunk where+  parseJSON = genericParseJSON++instance ToJSON Chunk where+  toJSON = genericToJSON

@@ -0,0 +1,32 @@+module Codec.Tiled.Layer.Data where++import Control.Applicative ((<|>))+import Data.Aeson (FromJSON(..), ToJSON(..), withArray, withText)+import Data.Text (Text)+import Data.Vector.Storable qualified as Storable+import GHC.Generics (Generic)++import Data.Tiled.GID (GID)++data LayerData+  = Base64 Text+  | GIDs (Storable.Vector GID)+  deriving (Eq, Show, Generic)++instance FromJSON LayerData where+  parseJSON v = encoded v <|> csv v+    where+      encoded =+        withText "Base64" $+          pure . Base64++      csv =+        withArray "GIDs" $+          fmap (GIDs . Storable.convert) . traverse parseJSON++instance ToJSON LayerData where+  toJSON = \case+    Base64 text ->+      toJSON text+    GIDs ints ->+      toJSON ints

@@ -0,0 +1,42 @@+module Codec.Tiled.Map where++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Layer (Layer)+import Codec.Tiled.Property (Property)+import Codec.Tiled.Tileset.Ref (TilesetRef)++data Map = Map+  { backgroundColor  :: Maybe Text              -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)+  , compressionLevel :: Maybe Int               -- ^ The compression level to use for tile layer data (defaults to -1, which means to use the algorithm default)+  , height           :: Int                     -- ^ Number of tile rows+  , hexSideLength    :: Maybe Int               -- ^ Length of the side of a hex tile in pixels (hexagonal maps only)+  , infinite         :: Maybe Bool              -- ^ Whether the map has infinite dimensions+  , layers           :: Vector Layer            -- ^ Array of Layers+  , nextLayerId      :: Int                     -- ^ Auto-increments for each layer+  , nextObjectId     :: Int                     -- ^ Auto-increments for each placed object+  , orientation      :: Text                    -- ^ @orthogonal@, @isometric@, @staggered@ or @hexagonal@+  , parallaxOriginX  :: Maybe Double            -- ^ X coordinate of the parallax origin in pixels (default: 0)+  , parallaxOriginY  :: Maybe Double            -- ^ Y coordinate of the parallax origin in pixels (default: 0)+  , properties       :: Maybe (Vector Property) -- ^ Array of Properties+  , renderOrder      :: Maybe Text              -- ^ @right-down@ (the default), @right-up@, @left-down@ or @left-up@ (currently only supported for orthogonal maps)+  , staggerAxis      :: Maybe Text              -- ^ x or y (staggered / hexagonal maps only)+  , staggerIndex     :: Maybe Text              -- ^ odd or even (staggered / hexagonal maps only)+  , tiledVersion     :: Text                    -- ^ The Tiled version used to save the file+  , tileHeight       :: Int                     -- ^ Map grid height+  , tilesets         :: Vector TilesetRef       -- ^ Array of Tilesets+  , tileWidth        :: Int                     -- ^ Map grid width+  , type_            :: Text                    -- ^ @map@+  , version          :: Text                    -- ^ The JSON format version+  , width            :: Int                     -- ^ Number of tile columns+  }+  deriving (Eq, Show, Generic)++instance FromJSON Map where+  parseJSON = genericParseJSON++instance ToJSON Map where+  toJSON = genericToJSON

@@ -0,0 +1,37 @@+module Codec.Tiled.Map.IO+  ( MapError(..)+  , readFile+  , writeFile+  ) where++import Prelude hiding (readFile, writeFile)++import Control.Exception (Exception, throwIO)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Aeson qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.Text (Text)+import Data.Text qualified as Text++import Codec.Tiled.Map (Map)++newtype MapError = MapError Text+  deriving (Eq, Show)++instance Exception MapError++readFile :: MonadIO m => FilePath -> m Map+readFile source = liftIO do+  bytes <- ByteString.readFile source+  case decodeMap bytes of+    Left msg ->+      throwIO $ MapError (Text.pack msg)+    Right res ->+      pure res++decodeMap :: ByteString -> Either String Map+decodeMap = Aeson.eitherDecodeStrict'++writeFile :: MonadIO m => FilePath -> Map -> m ()+writeFile destination = liftIO . Aeson.encodeFile destination

@@ -0,0 +1,38 @@+module Codec.Tiled.Object where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Object.Point (Point)+import Codec.Tiled.Object.Text qualified as Object (Text)+import Codec.Tiled.Property (Property)+import Data.Tiled.GID (GID)++data Object = Object+  { ellipse    :: Maybe Bool              -- ^ Used to mark an object as an ellipse+  , gid        :: Maybe GID               -- ^ Global tile ID, only if object represents a tile+  , height     :: Double                  -- ^ Height in pixels.+  , id         :: Int                     -- ^ Incremental ID, unique across all objects+  , name       :: Text                    -- ^ String assigned to name field in editor+  , point      :: Maybe Bool              -- ^ Used to mark an object as a point+  , polygon    :: Maybe (Vector Point)    -- ^ Array of Points, in case the object is a polygon+  , polyline   :: Maybe (Vector Point)    -- ^ Array of Points, in case the object is a polyline+  , properties :: Maybe (Vector Property) -- ^ Array of Properties+  , rotation   :: Double                  -- ^ Angle in degrees clockwise+  , template   :: Maybe FilePath          -- ^ Reference to a template file, in case object is a template instance+  , text       :: Maybe Object.Text       -- ^ Only used for text objects+  , type_      :: Text                    -- ^ String assigned to type field in editor+  , visible    :: Bool                    -- ^ Whether object is shown in editor.+  , width      :: Double                  -- ^ Width in pixels.+  , x          :: Double                  -- ^ X coordinate in pixels+  , y          :: Double                  -- ^ Y coordinate in pixels+  }+  deriving (Eq, Show, Generic)++instance FromJSON Object where+  parseJSON = genericParseJSON++instance ToJSON Object where+  toJSON = genericToJSON

@@ -0,0 +1,17 @@+module Codec.Tiled.Object.Point where++import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data Point = Point+  { x :: Double -- ^ X coordinate in pixels+  , y :: Double -- ^ Y coordinate in pixels+  }+  deriving (Eq, Show, Generic)++instance FromJSON Point where+  parseJSON = genericParseJSON++instance ToJSON Point where+  toJSON = genericToJSON

@@ -0,0 +1,21 @@+module Codec.Tiled.Object.Template where++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Data.Text (Text)+import GHC.Generics (Generic)++import Codec.Tiled.Object (Object)+import Codec.Tiled.Tileset (Tileset)++data Template = Template+  { type_   :: Text          -- ^ template+  , tileset :: Maybe Tileset -- ^ External tileset used by the template (optional)+  , object  :: Object        -- ^ The object instantiated by this template+  }+  deriving (Eq, Show, Generic)++instance FromJSON Template where+  parseJSON = genericParseJSON++instance ToJSON Template where+  toJSON = genericToJSON

@@ -0,0 +1,37 @@+module Codec.Tiled.Object.Template.IO+  ( TemplateError(..)+  , readFile+  , writeFile+  ) where++import Prelude hiding (readFile, writeFile)++import Control.Exception (Exception, throwIO)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Aeson qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.Text (Text)+import Data.Text qualified as Text++import Codec.Tiled.Object.Template (Template)++newtype TemplateError = TemplateError Text+  deriving (Eq, Show)++instance Exception TemplateError++readFile :: MonadIO m => FilePath -> m Template+readFile source = liftIO do+  bytes <- ByteString.readFile source+  case decodeMap bytes of+    Left msg ->+      throwIO $ TemplateError (Text.pack msg)+    Right res ->+      pure res++decodeMap :: ByteString -> Either String Template+decodeMap = Aeson.eitherDecodeStrict'++writeFile :: MonadIO m => FilePath -> Template -> m ()+writeFile destination = liftIO . Aeson.encodeFile destination

@@ -0,0 +1,28 @@+module Codec.Tiled.Object.Text where++import Data.Text qualified as The+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data Text = Text+  { bold       :: Maybe Bool     -- ^  Whether to use a bold font (default: false)+  , color      :: Maybe The.Text -- ^  Hex-formatted color (#RRGGBB or #AARRGGBB) (default: #000000)+  , fontFamily :: Maybe The.Text -- ^  Font family (default: sans-serif)+  , hAlign     :: Maybe The.Text -- ^  Horizontal alignment (center, right, justify or left (default))+  , italic     :: Maybe Bool     -- ^  Whether to use an italic font (default: false)+  , kerning    :: Maybe Bool     -- ^  Whether to use kerning when placing characters (default: true)+  , pixelSize  :: Maybe Int      -- ^  Pixel size of font (default: 16)+  , strikeout  :: Maybe Bool     -- ^  Whether to strike out the text (default: false)+  , text       :: The.Text       -- ^  Text+  , underline  :: Maybe Bool     -- ^  Whether to underline the text (default: false)+  , vAlign     :: Maybe The.Text -- ^  Vertical alignment (center, bottom or top (default))+  , wrap       :: Maybe Bool     -- ^  Whether the text is wrapped within the object bounds (default: false)+  }+  deriving (Eq, Show, Generic)++instance FromJSON Text where+  parseJSON = genericParseJSON++instance ToJSON Text where+  toJSON = genericToJSON

@@ -0,0 +1,21 @@+module Codec.Tiled.Property where++import Data.Aeson (Value)+import Data.Text (Text)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data Property = Property+  { name         :: Text       -- ^ Name of the property+  , type_        :: Maybe Text -- ^ Type of the property (@string@ (default), @int@, @float@, @bool@, @color@, @file@, @object@ or @class@)+  , propertyType :: Text       -- ^ Name of the custom property type, when applicable+  , value        :: Value      -- ^ Value of the property+  }+  deriving (Eq, Show, Generic)++instance FromJSON Property where+  parseJSON = genericParseJSON++instance ToJSON Property where+  toJSON = genericToJSON

@@ -0,0 +1,50 @@+module Codec.Tiled.Tileset where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Property (Property)+import Codec.Tiled.Tileset.Grid (Grid)+import Codec.Tiled.Tileset.Terrain (Terrain)+import Codec.Tiled.Tileset.Tile (Tile)+import Codec.Tiled.Tileset.TileOffset (TileOffset)+import Codec.Tiled.Tileset.Transformations (Transformations)+import Codec.Tiled.Tileset.WangSet (WangSet)+import Data.Tiled.GID (GID)++data Tileset = Tileset+  { backgroundColor  :: Maybe Text              -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)+  , columns          :: Int                     -- ^ The number of tile columns in the tileset+  , firstGid         :: Maybe GID               -- ^ GID corresponding to the first tile in the set+  , grid             :: Maybe Grid              -- ^ (optional)+  , image            :: FilePath                -- ^ Image used for tiles in this set+  , imageHeight      :: Int                     -- ^ Height of source image in pixels+  , imageWidth       :: Int                     -- ^ Width of source image in pixels+  , margin           :: Int                     -- ^ Buffer between image edge and first tile (pixels)+  , name             :: Text                    -- ^ Name given to this tileset+  , objectAlignment  :: Maybe Text              -- ^ Alignment to use for tile objects (unspecified (default), @topleft@, @top@, @topright@, @left@, @center@, @right@, @bottomleft@, @bottom@ or @bottomright@)+  , properties       :: Maybe (Vector Property) -- ^ Array of Properties+  , source           :: Maybe FilePath          -- ^ The external file that contains this tilesets data+  , spacing          :: Int                     -- ^ Spacing between adjacent tiles in image (pixels)+  , terrains         :: Maybe (Vector Terrain)  -- ^ Array of Terrains (optional)+  , tileCount        :: Int                     -- ^ The number of tiles in this tileset+  , tiledVersion     :: Maybe Text              -- ^ The Tiled version used to save the file+  , tileHeight       :: Int                     -- ^ Maximum height of tiles in this set+  , tileOffset       :: Maybe TileOffset        -- ^ (optional)+  , tiles            :: Maybe (Vector Tile)     -- ^ Array of Tiles (optional)+  , tileWidth        :: Int                     -- ^ Maximum width of tiles in this set+  , transformations  :: Maybe Transformations   -- ^ Allowed transformations (optional)+  , transparentColor :: Maybe Text              -- ^ Hex-formatted color (#RRGGBB) (optional)+  , type_            :: Maybe Text              -- ^ @tileset@ (for tileset files)+  , version          :: Maybe Text              -- ^ The JSON format version+  , wangSets         :: Maybe (Vector WangSet)  -- ^ Array of Wang sets+  }+  deriving (Eq, Show, Generic)++instance FromJSON Tileset where+  parseJSON = genericParseJSON++instance ToJSON Tileset where+  toJSON = genericToJSON

@@ -0,0 +1,17 @@+module Codec.Tiled.Tileset.Frame where++import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data Frame = Frame+  { duration :: Int -- ^ Frame duration in milliseconds+  , tileId   :: Int -- ^ Local tile ID representing this frame+  }+  deriving (Eq, Show, Generic)++instance FromJSON Frame where+  parseJSON = genericParseJSON++instance ToJSON Frame where+  toJSON = genericToJSON

@@ -0,0 +1,19 @@+module Codec.Tiled.Tileset.Grid where++import Data.Text (Text)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data Grid = Grid+  { height      :: Int        -- ^ Cell height of tile grid+  , orientation :: Maybe Text -- ^ orthogonal (default) or isometric+  , width       :: Int        -- ^ Cell width of tile grid+  }+  deriving (Eq, Show, Generic)++instance FromJSON Grid where+  parseJSON = genericParseJSON++instance ToJSON Grid where+  toJSON = genericToJSON

@@ -0,0 +1,37 @@+module Codec.Tiled.Tileset.IO+  ( TilesetError(..)+  , readFile+  , writeFile+  ) where++import Prelude hiding (readFile, writeFile)++import Control.Exception (Exception, throwIO)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Aeson qualified as Aeson+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.Text (Text)+import Data.Text qualified as Text++import Codec.Tiled.Tileset (Tileset)++newtype TilesetError = TilesetError Text+  deriving (Eq, Show)++instance Exception TilesetError++readFile :: MonadIO m => FilePath -> m Tileset+readFile source = liftIO do+  bytes <- ByteString.readFile source+  case decodeMap bytes of+    Left msg ->+      throwIO $ TilesetError (Text.pack msg)+    Right res ->+      pure res++decodeMap :: ByteString -> Either String Tileset+decodeMap = Aeson.eitherDecodeStrict'++writeFile :: MonadIO m => FilePath -> Tileset -> m ()+writeFile destination = liftIO . Aeson.encodeFile destination

@@ -0,0 +1,48 @@+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+      { firstGid :: GID      -- ^ GID corresponding to the first tile in the set+      , source   :: FilePath -- ^ The external file that contains this tilesets data+      }+  | TilesetEmbedded+      { firstGid :: GID+      , embedded :: Tileset+      }+  deriving (Eq, Show, Generic)++instance FromJSON TilesetRef where+  parseJSON v = refP v <|> embeddedP v+    where+      refP = Aeson.withObject "TilesetRef" \o -> do+        source <- o .: "source"+        firstGid <- o .: "firstgid"+        pure TilesetRef{..}++      embeddedP = Aeson.withObject "TilesetEmbedded" \o -> do+        embedded <- parseJSON (Aeson.Object o)+        firstGid <- o .: "firstgid"+        pure TilesetEmbedded{..}++instance ToJSON TilesetRef where+  toJSON = \case+    TilesetRef{..} -> Aeson.object+      [ "firstgid" .= firstGid+      , "source"   .= source+      ]+    TilesetEmbedded{..} ->+      case toJSON embedded of+        Aeson.Object o ->+          Aeson.Object $+            KeyMap.insert "firstGid" (toJSON firstGid) o+        _nonObject ->+          error "assert: TilesetRef is Object"

@@ -0,0 +1,21 @@+module Codec.Tiled.Tileset.Terrain where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Property (Property)++data Terrain = Terrain+  { name       :: Text                    -- ^ Name of terrain+  , properties :: Maybe (Vector Property) -- ^ array Array of Properties+  , tile       :: Int                     -- ^ Local ID of tile representing terrain+  }+  deriving (Eq, Show, Generic)++instance FromJSON Terrain where+  parseJSON = genericParseJSON++instance ToJSON Terrain where+  toJSON = genericToJSON

@@ -0,0 +1,30 @@+module Codec.Tiled.Tileset.Tile where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Layer (Layer)+import Codec.Tiled.Property (Property)+import Codec.Tiled.Tileset.Frame (Frame)++data Tile = Tile+  { animation   :: Maybe (Vector Frame)    -- ^ Array of Frames+  , id          :: Int                     -- ^ Local ID of the tile+  , image       :: Maybe FilePath          -- ^ Image representing this tile (optional)+  , imageHeight :: Int                     -- ^ Height of the tile image in pixels+  , imageWidth  :: Int                     -- ^ Width of the tile image in pixels+  , objectGroup :: Maybe Layer             -- ^ Layer with type objectgroup, when collision shapes are specified (optional)+  , probability :: Maybe Double            -- ^ Percentage chance this tile is chosen when competing with others in the editor (optional)+  , properties  :: Maybe (Vector Property) -- ^ Array of Properties+  , terrain     :: Maybe (Vector Int)      -- ^ Index of terrain for each corner of tile (optional)+  , type_       :: Maybe Text              -- ^ The type of the tile (optional)+  }+  deriving (Eq, Show, Generic)++instance FromJSON Tile where+  parseJSON = genericParseJSON++instance ToJSON Tile where+  toJSON = genericToJSON

@@ -0,0 +1,17 @@+module Codec.Tiled.Tileset.TileOffset where++import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data TileOffset = TileOffset+  { x :: Int -- ^ Horizontal offset in pixels+  , y :: Int -- ^ Vertical offset in pixels (positive is down)+  }+  deriving (Eq, Show, Generic)++instance FromJSON TileOffset where+  parseJSON = genericParseJSON++instance ToJSON TileOffset where+  toJSON = genericToJSON

@@ -0,0 +1,19 @@+module Codec.Tiled.Tileset.Transformations where++import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data Transformations = Transformations+  { hFlip               :: Maybe Bool -- ^ Tiles can be flipped horizontally+  , vFlip               :: Maybe Bool -- ^ Tiles can be flipped vertically+  , rotate              :: Maybe Bool -- ^ Tiles can be rotated in 90-degree increments+  , preferUntransformed :: Maybe Bool -- ^ Whether untransformed tiles remain preferred, otherwise transformed tiles are used to produce more variations+  }+  deriving (Eq, Show, Generic)++instance FromJSON Transformations where+  parseJSON = genericParseJSON++instance ToJSON Transformations where+  toJSON = genericToJSON

@@ -0,0 +1,23 @@+module Codec.Tiled.Tileset.WangColor where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Property (Property)++data WangColor = WangColor+  { color       :: Text                     -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB)+  , name        :: Text                     -- ^ Name of Wang color+  , probability :: Double                   -- ^ Probability used when randomizing+  , properties  :: Maybe (Vector Property)  -- ^ Array of Properties+  , tile        :: Int                      -- ^ Local ID of tile representing terrain+  }+  deriving (Eq, Show, Generic)++instance FromJSON WangColor where+  parseJSON = genericParseJSON++instance ToJSON WangColor where+  toJSON = genericToJSON

@@ -0,0 +1,26 @@+module Codec.Tiled.Tileset.WangSet where++import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Codec.Tiled.Property (Property)+import Codec.Tiled.Tileset.WangColor (WangColor)+import Codec.Tiled.Tileset.WangTile (WangTile)++data WangSet = WangSet+  { colors     :: Vector WangColor        -- ^ Array of Wang colors (since 1.5)+  , name       :: Text                    -- ^ Name of terrain+  , properties :: Maybe (Vector Property) -- ^ array Array of Properties+  , tile       :: Int                     -- ^ Local ID of tile representing terrain+  , type_      :: Text                    -- ^ @corner@, @edge@ or @mixed@ (since 1.5)+  , wangTiles  :: Vector WangTile         -- ^ Array of Wang tiles+  }+  deriving (Eq, Show, Generic)++instance FromJSON WangSet where+  parseJSON = genericParseJSON++instance ToJSON WangSet where+  toJSON = genericToJSON

@@ -0,0 +1,18 @@+module Codec.Tiled.Tileset.WangTile where++import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)++data WangTile = WangTile+  { tileId :: Int        -- ^ Local ID of tile+  , wangId :: Vector Int -- ^ Array of Wang color indexes (uchar[8])+  }+  deriving (Eq, Show, Generic)++instance FromJSON WangTile where+  parseJSON = genericParseJSON++instance ToJSON WangTile where+  toJSON = genericToJSON

@@ -0,0 +1,24 @@+module Codec.Tiled.World where++import Data.Aeson (FromJSON(..), ToJSON(..), genericParseJSON, genericToJSON)+import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic)++import Codec.Tiled.Aeson (mkOptions, remapFields_)+import Codec.Tiled.World.Map (Map)+import Codec.Tiled.World.Pattern (Pattern)++data World = World+  { maps                 :: Maybe (Vector Map)+  , patterns             :: Maybe (Vector Pattern)+  , type_                :: Maybe Text              -- ^ @world@ (for world files)+  , onlyShowAdjacentMaps :: Maybe Bool+  }+  deriving (Eq, Show, Generic)++instance FromJSON World where+  parseJSON = genericParseJSON (mkOptions remapFields_)++instance ToJSON World where+  toJSON = genericToJSON (mkOptions remapFields_)

@@ -0,0 +1,17 @@+module Codec.Tiled.World.Map where++import Data.Aeson (FromJSON(..), ToJSON(..))+import GHC.Generics (Generic)++data Map = Map+  { fileName :: FilePath+  , x        :: Int -- ^ Global position X, in pixels+  , y        :: Int -- ^ Global position Y, in pixels+  , width    :: Maybe Int+  , height   :: Maybe Int+  }+  deriving (Eq, Show, Generic)++-- XXX: don't transform, fileName field+instance FromJSON Map+instance ToJSON Map

@@ -0,0 +1,19 @@+module Codec.Tiled.World.Pattern where++import Data.Aeson (FromJSON(..), ToJSON(..))+import Data.Text (Text)+import GHC.Generics (Generic)++data Pattern = Pattern+  { regexp      :: Text+  , mapHeight   :: Maybe Int+  , mapWidth    :: Maybe Int+  , multiplierX :: Int+  , multiplierY :: Int+  , offsetX     :: Int+  , offsetY     :: Int+  }+  deriving (Eq, Show, Generic)++instance FromJSON Pattern+instance ToJSON Pattern

@@ -1,447 +0,0 @@-{-# 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 { unGlobalId :: Int }-  deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)----- | A locally indexed identifier.-newtype LocalId = LocalId { unLocalId :: Int }-  deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)---data XYPair a = XYPair a a--instance FromJSON a => FromJSON (XYPair a) where-  parseJSON (A.Object o) =-    XYPair <$> o .: "x"-           <*> o .: "y"-  parseJSON invalid = typeMismatch "Object" invalid--instance ToJSON a => ToJSON (XYPair a) where-  toJSON (XYPair x y) =-    object [ "x" .= x-           , "y" .= y-           ]--fromXYPair :: XYPair a -> (a, a)-fromXYPair (XYPair x y) = (x, y)--toXYPair :: (a, a) -> XYPair a-toXYPair (x, y) = XYPair x y--omitNulls :: Value -> Value-omitNulls (A.Object hs) = A.Object-                        . fromList-                        . filter ((/= Null) . snd)-                        $ toList hs-omitNulls x = 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 o s d = fromMaybe d <$> o .:? s---data Object = Object { objectId         :: Int-                       -- ^ Incremental id - unique across all objects-                     , objectWidth      :: Double-                       -- ^ Width in pixels. Ignored if using a gid.-                     , objectHeight     :: Double-                       -- ^ Height in pixels. Ignored if using a gid.-                     , objectName       :: Text-                       -- ^ String assigned to name field in editor-                     , objectType       :: Text-                       -- ^ String assigned to type field in editor-                     , objectProperties :: Map Text Text-                       -- ^ String key-value pairs-                     , objectVisible    :: Bool-                       -- ^ Whether object is shown in editor.-                     , objectX          :: Double-                       -- ^ x coordinate in pixels-                     , objectY          :: Double-                       -- ^ y coordinate in pixels-                     , objectRotation   :: Float-                       -- ^ Angle in degrees clockwise-                     , objectGid        :: Maybe GlobalId-                       -- ^ GID, only if object comes from a Tilemap-                     , objectEllipse    :: Bool-                       -- ^ Used to mark an object as an ellipse-                     , objectPolygon    :: Maybe (Vector (Double, Double))-                       -- ^ A list of x,y coordinates in pixels-                     , objectPolyline   :: Maybe (Vector (Double, Double))-                       -- ^ A list of x,y coordinates in pixels-                     , objectText       :: Map Text Text-                       -- ^ String key-value pairs-                     } deriving (Eq, Generic, Show)--instance FromJSON Object where-  parseJSON (A.Object o) = Object <$> o .: "id"-                                  <*> o .: "width"-                                  <*> o .: "height"-                                  <*> o .: "name"-                                  <*> o .: "type"-                                  <*> parseDefault o "properties" M.empty-                                  <*> o .: "visible"-                                  <*> o .: "x"-                                  <*> o .: "y"-                                  <*> o .: "rotation"-                                  <*> o .:? "gid"-                                  <*> parseDefault o "ellipse" False-                                  <*> (fmap . fmap . fmap) fromXYPair (o .:? "polygon")-                                  <*> (fmap . fmap . fmap) fromXYPair (o .:? "polyline")-                                  <*> parseDefault o "text" M.empty-  parseJSON invalid = typeMismatch "Object" invalid--instance ToJSON Object where-  toJSON Object{..} = omitNulls $-    object [ "id"         .= objectId-           , "width"      .= objectWidth-           , "height"     .= objectHeight-           , "name"       .= objectName-           , "type"       .= objectType-           , "properties" .= objectProperties-           , "visible"    .= objectVisible-           , "x"          .= objectX-           , "y"          .= objectY-           , "rotation"   .= objectRotation-           , "gid"        .= objectGid-           , "ellipse"    .= objectEllipse-           , "polygon"    .= (fmap . fmap) toXYPair objectPolygon-           , "polyline"   .= (fmap . fmap) toXYPair objectPolyline-           , "text"       .= objectText-           ]---data Layer = Layer { layerWidth      :: Double-                     -- ^ Column count. Same as map width for fixed-size maps.-                   , layerHeight     :: Double-                     -- ^ Row count. Same as map height for fixed-size maps.-                   , layerName       :: Text-                     -- ^ Name assigned to this layer-                   , layerType       :: Text -- TODO: LayerType-                     -- ^ “tilelayer”, “objectgroup”, or “imagelayer”-                   , layerVisible    :: Bool-                     -- ^ Whether layer is shown or hidden in editor-                   , layerX          :: Double-                     -- ^ Horizontal layer offset in tiles. Always 0.-                   , layerY          :: Double-                     -- ^ Vertical layer offset in tiles. Always 0.-                   , layerData       :: Maybe (Vector GlobalId)-                     -- ^ Array of GIDs. tilelayer only.-                   , layerObjects    :: Maybe (Vector Object)-                     -- ^ Array of Objects. objectgroup only.-                   , layerProperties :: Map Text Text-                     -- ^ string key-value pairs.-                   , layerOpacity    :: Float-                     -- ^ Value between 0 and 1-                   , layerDraworder  :: Text -- TODO: DrawOrder-                     -- ^ “topdown” (default) or “index”. objectgroup only.-                   } deriving (Eq, Generic, Show)--instance FromJSON Layer where-  parseJSON (A.Object o) = Layer <$> (o .: "width"      <|> pure 0)-                                 <*> (o .: "height"     <|> pure 0)-                                 <*>  o .: "name"-                                 <*>  o .: "type"-                                 <*>  o .: "visible"-                                 <*>  o .: "x"-                                 <*>  o .: "y"-                                 <*> (o .: "data"       <|> pure Nothing)-                                 <*> o .:? "objects"-                                 <*> (o .: "properties" <|> pure mempty)-                                 <*>  o .: "opacity"-                                 <*> (o .: "draworder"  <|> pure "topdown")-  parseJSON invalid = typeMismatch "Layer" invalid--instance ToJSON Layer where-  toJSON Layer{..} = omitNulls $-    object [ "width"      .= layerWidth-           , "height"     .= layerHeight-           , "name"       .= layerName-           , "type"       .= layerType-           , "visible"    .= layerVisible-           , "x"          .= layerX-           , "y"          .= layerY-           , "data"       .= layerData-           , "objects"    .= layerObjects-           , "properties" .= layerProperties-           , "opacity"    .= layerOpacity-           , "draworder"  .= layerDraworder-           ]---data Terrain = Terrain { terrainName :: Text-                         -- ^ Name of terrain-                       , terrainTile :: LocalId-                         -- ^ Local ID of tile representing terrain-                       } deriving (Eq, Generic, Show)--instance FromJSON Terrain where-  parseJSON (A.Object o) = Terrain <$> o .: "name"-                                   <*> o .: "tile"-  parseJSON invalid = typeMismatch "Terrain" invalid--instance ToJSON Terrain where-  toJSON Terrain{..} = object [ "name" .= terrainName-                              , "tile" .= terrainTile-                              ]----data Frame = Frame { frameDuration :: Int-                   , frameTileId   :: LocalId-                   } deriving (Eq, Generic, Show)--instance FromJSON Frame where-  parseJSON (A.Object o) = Frame <$> o .: "duration"-                                 <*> o .: "tileid"-  parseJSON invalid = typeMismatch "Frame" invalid--instance ToJSON Frame where-  toJSON Frame{..} = object [ "duration" .= frameDuration-                            , "tileid"   .= frameTileId-                            ]---data Tile = Tile { tileId          :: LocalId-                 , tileProperties  :: Map Text Text-                 , tileImage       :: Maybe Value-                 , tileObjectGroup :: Maybe (Vector Object)-                 , tileAnimation   :: Maybe (Vector Frame)-                 } deriving (Eq, Generic, Show)--instance FromJSON Tile where-  parseJSON (A.Object o) = Tile 0 <$> (o .: "properties"  <|> pure mempty)-                                  <*> (o .: "image"       <|> pure Nothing)-                                  <*> (o .: "objectGroup" <|> pure mempty)-                                  <*> (o .: "animation"   <|> pure mempty)-  parseJSON invalid = typeMismatch "Tile" invalid--instance ToJSON Tile where-  toJSON Tile{..} = object [ "properties"   .= tileProperties-                           , "image"        .= tileImage-                           , "objectGroup"  .= tileObjectGroup-                           , "animation"    .= tileAnimation-                           ]---data Tileset = Tileset { tilesetFirstgid       :: GlobalId-                         -- ^ GID corresponding to the first tile in the set-                       , tilesetImage          :: FilePath-                         -- ^ Image used for tiles in this set-                       , tilesetName           :: Text-                         -- ^ Name given to this tileset-                       , tilesetTilewidth      :: Int-                         -- ^ Maximum width of tiles in this set-                       , tilesetTileheight     :: Int-                         -- ^ Maximum height of tiles in this set-                       , tilesetImagewidth     :: Int-                         -- ^ Width of source image in pixels-                       , tilesetImageheight    :: Int-                         -- ^ Height of source image in pixels-                       , tilesetProperties     :: Map Text Text-                         -- ^ String key-value pairs-                       , tilesetPropertytypes  :: Map Text Text-                         -- ^ String key-value pairs-                       , tilesetMargin         :: Int-                         -- ^ Buffer between image edge and first tile (pixels)-                       , tilesetSpacing        :: Int-                         -- ^ Spacing between adjacent tiles in image (pixels)-                       , tilesetTileproperties :: Map GlobalId (Map Text Text)-                         -- ^ Per-tile properties, indexed by gid as string-                       , tilesetTerrains       :: Vector Terrain-                         -- ^ Array of Terrains (optional)-                       , tilesetColumns        :: Int-                         -- ^ The number of tile columns in the tileset-                       , tilesetTilecount      :: Int-                         -- ^ The number of tiles in this tileset-                       , tilesetTiles          :: Map LocalId Tile-                         -- ^ Tiles (optional)-                       } deriving (Eq, Generic, Show)--newtype TransitiveTilesetMap = TransitiveTilesetMap (Map LocalId Value)-  deriving (Show, Eq, Generic, FromJSON)--parseTiles :: A.Object -> Parser (Map LocalId Tile)-parseTiles o = do-  TransitiveTilesetMap localId2Value <- o .: "tiles"-  localIdAndTiles <- forM (M.toList localId2Value) $ \(lid, val) -> do-    tile <- parseJSON val-    return (lid, tile{ tileId = lid })-  return $ M.fromList localIdAndTiles--instance FromJSON Tileset where-  parseJSON (A.Object o) = Tileset <$>  o .: "firstgid"-                                   <*>  o .: "image"-                                   <*>  o .: "name"-                                   <*>  o .: "tilewidth"-                                   <*>  o .: "tileheight"-                                   <*>  o .: "imagewidth"-                                   <*>  o .: "imageheight"-                                   <*> (o .: "properties"     <|> pure mempty)-                                   <*> (o .: "propertytypes"  <|> pure mempty)-                                   <*>  o .: "margin"-                                   <*>  o .: "spacing"-                                   <*> (o .: "tileproperties" <|> pure mempty)-                                   <*> (o .: "terrains"       <|> pure mempty)-                                   <*>  o .: "columns"-                                   <*>  o .: "tilecount"-                                   <*> (parseTiles o          <|> pure mempty)-  parseJSON invalid = typeMismatch "Tileset" invalid--instance ToJSON Tileset where-  toJSON Tileset{..} = object [ "firstgid"       .= tilesetFirstgid-                              , "image"          .= tilesetImage-                              , "name"           .= tilesetName-                              , "tilewidth"      .= tilesetTilewidth-                              , "tileheight"     .= tilesetTileheight-                              , "imagewidth"     .= tilesetImagewidth-                              , "imageheight"    .= tilesetImageheight-                              , "properties"     .= tilesetProperties-                              , "propertytypes"  .= tilesetPropertytypes-                              , "margin"         .= tilesetMargin-                              , "spacing"        .= tilesetSpacing-                              , "tileproperties" .= tilesetTileproperties-                              , "terrains"       .= tilesetTerrains-                              , "columns"        .= tilesetColumns-                              , "tilecount"      .= tilesetTilecount-                              , "tiles"          .= tilesetTiles-                              ]--data Version-  = VersionFloat Float-  | VersionText Text-  deriving (Eq, Ord, Show, Generic)--instance FromJSON Version where-  parseJSON v =-    fmap VersionFloat (parseJSON v) <|>-    fmap VersionText (parseJSON v)--instance ToJSON Version where-  toJSON version = case version of-    VersionFloat f -> toJSON f-    VersionText t  -> toJSON t--data Orientation-  = Orthogonal-  | Isometric-  | Staggered-  | Orientation Text-  deriving (Eq, Ord, Show, Generic)--instance FromJSON Orientation where-  parseJSON = withText "Orientation" $ \t ->-    case t of-      "orthogonal" -> pure Orthogonal-      "isometric"  -> pure Isometric-      "staggered"  -> pure Staggered-      _otherwise   -> pure $ Orientation t--instance ToJSON Orientation where-  toJSON o = toJSON $ case o of-    Orthogonal    -> "orthogonal"-    Isometric     -> "isometric"-    Staggered     -> "staggered"-    Orientation t -> t---- | The full monty.-data Tiledmap = Tiledmap { tiledmapVersion         :: Version-                           -- ^ The JSON format version-                         , tiledmapTiledversion    :: Version-                           -- ^ The Tiled version used to save the file-                         , tiledmapWidth           :: Int-                           -- ^ Number of tile columns-                         , tiledmapHeight          :: Int-                           -- ^ Number of tile rows-                         , tiledmapTilewidth       :: Double-                           -- ^ Map grid width.-                         , tiledmapTileheight      :: Double-                           -- ^ Map grid height.-                         , tiledmapOrientation     :: Orientation-                           -- ^ Orthogonal, isometric, or staggered-                         , tiledmapLayers          :: Vector Layer-                           -- ^ Array of Layers-                         , tiledmapTilesets        :: Vector Tileset-                           -- ^ Array of Tilesets-                         , tiledmapBackgroundcolor :: Maybe Text-                           -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)-                         , tiledmapRenderorder     :: Text -- TODO: RenderOrder-                           -- ^ Rendering direction (orthogonal maps only)-                         , tiledmapProperties      :: Map Text Text-                           -- ^ String key-value pairs-                         , tiledmapNextobjectid    :: Int-                           -- ^ Auto-increments for each placed object-                         } deriving (Eq, Generic, Show)--instance FromJSON Tiledmap where-  parseJSON (A.Object o) = Tiledmap <$>  o .: "version"-                                    <*>  o .: "tiledversion"-                                    <*>  o .: "width"-                                    <*>  o .: "height"-                                    <*>  o .: "tilewidth"-                                    <*>  o .: "tileheight"-                                    <*>  o .: "orientation"-                                    <*>  o .: "layers"-                                    <*>  o .: "tilesets"-                                    <*> (o .: "backgroundcolor" <|> pure Nothing)-                                    <*>  o .: "renderorder"-                                    <*> (o .: "properties"      <|> pure mempty)-                                    <*>  o .: "nextobjectid"-  parseJSON invalid = typeMismatch "Tiledmap" invalid--instance ToJSON Tiledmap where-  toJSON Tiledmap{..} = object [ "version"         .= tiledmapVersion-                               , "tiledversion"    .= tiledmapTiledversion-                               , "width"           .= tiledmapWidth-                               , "height"          .= tiledmapHeight-                               , "tilewidth"       .= tiledmapTilewidth-                               , "tileheight"      .= tiledmapTileheight-                               , "orientation"     .= tiledmapOrientation-                               , "layers"          .= tiledmapLayers-                               , "tilesets"        .= tiledmapTilesets-                               , "backgroundcolor" .= tiledmapBackgroundcolor-                               , "renderorder"     .= tiledmapRenderorder-                               , "properties"      .= tiledmapProperties-                               , "nextobjectid"    .= tiledmapNextobjectid-                               ]----- | Load a Tiled map from the given 'FilePath'.-loadTiledmap :: FilePath -> IO (Either String Tiledmap)-loadTiledmap = fmap eitherDecode . C8.readFile

@@ -0,0 +1,64 @@+{- | Global Tile IDs++https://doc.mapeditor.org/en/latest/reference/global-tile-ids/++-}++module Data.Tiled.GID where++import Data.Aeson (FromJSON(..), ToJSON(..))+import Data.Bits (Bits(..), (.&.))+import Data.Bool (bool)+import Data.Word (Word32)+import Foreign (Storable(..))+import GHC.Generics (Generic)++newtype GID = GID { getGID :: Word32 }+  deriving (Eq, Show, Generic)+  deriving newtype (FromJSON, ToJSON, Storable, Bits)++pattern FLIPPED_HORIZONTALLY_BIT :: Int+pattern FLIPPED_HORIZONTALLY_BIT = 32++pattern FLIPPED_VERTICALLY_BIT :: Int+pattern FLIPPED_VERTICALLY_BIT = 31++pattern ROTATED_60_BIT :: Int+pattern ROTATED_60_BIT = 30++pattern ROTATED_120_BIT :: Int+pattern ROTATED_120_BIT = 29++data Flags = Flags+  { flippedHorizontally :: Bool+  , flippedVertically   :: Bool+  , rotated60           :: Bool+  , rotated120          :: Bool+  } deriving (Eq, Show, Generic)++flags :: GID -> Flags+flags (GID bits) = Flags+  { flippedHorizontally = testBit bits FLIPPED_HORIZONTALLY_BIT+  , flippedVertically   = testBit bits FLIPPED_VERTICALLY_BIT+  , rotated60           = testBit bits ROTATED_60_BIT+  , rotated120          = testBit bits ROTATED_120_BIT+  }++flagBits :: Word32+flagBits =+  bit FLIPPED_HORIZONTALLY_BIT .|.+  bit FLIPPED_VERTICALLY_BIT .|.+  bit ROTATED_60_BIT .|.+  bit ROTATED_120_BIT++toLocal :: GID -> Int+toLocal (GID bits) = fromIntegral $ bits .&. complement flagBits++fromLocal :: Flags -> Int -> GID+fromLocal Flags{..} localId =+  GID . fromIntegral $+    localId+    .|. bool 0 FLIPPED_HORIZONTALLY_BIT flippedHorizontally+    .|. bool 0 FLIPPED_VERTICALLY_BIT   flippedVertically+    .|. bool 0 ROTATED_60_BIT           rotated60+    .|. bool 0 ROTATED_120_BIT          rotated120

@@ -1,22 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications  #-}--module ParseObjectSpec where--import Data.Aeson (encode, eitherDecode)-import Test.Hspec-import Data.Either (isRight)-import Control.Monad (forM_)-import qualified Data.ByteString.Lazy.Char8 as C8--import Data.Aeson.Tiled--file :: FilePath-file = "maps/objects/obj1.json"--spec :: Spec-spec = describe "Obj1" $ do-  it "should parse just fine" $ do-    eobj <- fmap (eitherDecode @Object) $ C8.readFile file-    eobj `shouldSatisfy` isRight-

@@ -1,26 +0,0 @@-{-# LANGUAGE LambdaCase #-}--module RoundTripSpec where--import Data.Aeson (encode, eitherDecode)-import Test.Hspec-import Control.Monad (forM_)--import Data.Aeson.Tiled--files :: [FilePath]-files = [ "maps/example.json"-        , "maps/test1.json"-        , "maps/test2.json"-        , "maps/test3.json"-        , "maps/test4.json"-        ]--spec :: Spec-spec = describe "Round tripping" . forM_ files $ \file ->-    it (file ++ " should roundtrip and end up with the same Tiledmap") $-      loadTiledmap file >>= \case-        Right tm -> do-          let bs = encode tm-          eitherDecode bs `shouldBe` Right tm-        Left x -> fail x

@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,59 @@+module Main where++import Test.Tasty+import Test.Tasty.HUnit++import System.FilePath ((</>))+import System.IO.Temp (withSystemTempDirectory)++import qualified Codec.Tiled.Map.IO as Map+import qualified Codec.Tiled.Tileset.IO as Tileset++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Codec"+  [ mapCodecTests+  , tilesetCodecTests+  ]++mapCodecTests :: TestTree+mapCodecTests = testGroup "Map"+  [ testGroup "Roundtrip"+      [ testCase "Embedded tileset" mapTestRoundtripEmbedded+      , testCase "External tileset" mapTestRoundtripExternal+      ]+  ]++mapTestRoundtripEmbedded :: IO ()+mapTestRoundtripEmbedded = do+  embeddedZstd <- Map.readFile "maps/microgue/embedded-zstd.tmj"+  withSystemTempDirectory "" \path -> do+    let out = path </> "map.tsj"+    Map.writeFile out embeddedZstd+    embeddedZstdOut <- Map.readFile out+    embeddedZstd @?= embeddedZstdOut++mapTestRoundtripExternal :: IO ()+mapTestRoundtripExternal = do+  embeddedZstd <- Map.readFile "maps/microgue/external-zstd.tmj"+  withSystemTempDirectory "" \path -> do+    let out = path </> "map.tsj"+    Map.writeFile out embeddedZstd+    embeddedZstdOut <- Map.readFile out+    embeddedZstd @?= embeddedZstdOut++tilesetCodecTests :: TestTree+tilesetCodecTests = testGroup "Tileset"+  [ testCase "Roundtrip" tilesetCodecRoundtrip+  ]++tilesetCodecRoundtrip :: IO ()+tilesetCodecRoundtrip = do+  tiles <- Tileset.readFile "maps/microgue/tiles.tsj"+  withSystemTempDirectory "" \path -> do+    let out = path </> "tiles.tsj"+    Tileset.writeFile out tiles+    embeddedZstdOut <- Tileset.readFile out+    tiles @?= embeddedZstdOut