aeson-tiled 0.0.0.1 → 0.0.1.0

raw patch · 8 files changed

+239/−124 lines, 8 filesdep +hspec-discoverdep ~aesondep ~basedep ~bytestringnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hspec-discover

Dependency ranges changed: aeson, base, bytestring, containers, text, vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +16/−0
• README.md +8/−6
• aeson-tiled.cabal +26/−24
• app/Main.hs +0/−6
• src/Data/Aeson/Tiled.hs +140/−64
• test/ParseObjectSpec.hs +22/−0
• test/RoundTripSpec.hs +26/−0
• test/Spec.hs +1/−24

@@ -0,0 +1,16 @@+# Change Log++## [0.0.1.0] - 2022-02-19++Package moved to https://github.com/haskell-game/aeson-tiled++- Fixed frame serialization.+- Updated to match recent Tiled format.+- Maintenance info update.++## [0.0.0.1] - 2017-10-24++Initial release.++[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

@@ -1,8 +1,10 @@ # aeson-tiled-[![Build Status](https://travis-ci.org/schell/aeson-tiled.svg?branch=master)](https://travis-ci.org/schell/aeson-tiled)+ [![Hackage](https://img.shields.io/hackage/v/aeson-tiled.svg)](https://hackage.haskell.org/package/aeson-tiled)-`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!++Types and instances for [Tiled](https://www.mapeditor.org/) map editor `.tmj` 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!

@@ -1,40 +1,41 @@ name:                aeson-tiled-version:             0.0.0.1+version:             0.0.1.0 synopsis:            Aeson instances for the Tiled map editor.-description:         The mighty Tiled 2d map editor is an open source+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/schell/aeson-tiled#readme+homepage:            https://github.com/haskell-game/aeson-tiled license:             BSD3 license-file:        LICENSE+maintainer:          aenor.realm@gmai.com author:              Schell Scivally-maintainer:          schell@takt.com-copyright:           Copyright: (c) 2017 Schell Scivally-category:            Game+copyright:           (c) 2017 Schell Scivally+category:            Game Engine build-type:          Simple-extra-source-files:  README.md cabal-version:       >=1.10 +extra-source-files:+  README.md,+  ChangeLog.md+ library   hs-source-dirs:      src   exposed-modules:     Data.Aeson.Tiled-  build-depends:       base >= 4.7 && < 5-                     , bytestring >= 0.10-                     , aeson >= 1.1-                     , containers >= 0.5-                     , text >= 1.2-                     , vector >= 0.12+  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 -executable aeson-tiled-exe-  hs-source-dirs:      app-  main-is:             Main.hs-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N-  build-depends:       base-                     , aeson-tiled-  default-language:    Haskell2010+flag tests+  manual: True+  default: False  test-suite aeson-tiled-test+  if !flag(tests)+    buildable: False   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Spec.hs@@ -42,9 +43,10 @@                      , aeson >= 1.1                      , aeson-tiled                      , hspec+                     , hspec-discover+                     , bytestring   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010--source-repository head-  type:     git-  location: https://github.com/schell/aeson-tiled+  other-modules:+    ParseObjectSpec+    RoundTripSpec

@@ -1,6 +0,0 @@-module Main where--import Data.Aeson.Tiled--main :: IO ()-main = print =<< loadTiledmap "example.json"

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}@@ -24,8 +25,10 @@ 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)  @@ -39,33 +42,68 @@   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      :: Int+                     , objectWidth      :: Double                        -- ^ Width in pixels. Ignored if using a gid.-                     , objectHeight     :: Int+                     , objectHeight     :: Double                        -- ^ Height in pixels. Ignored if using a gid.-                     , objectName       :: String+                     , objectName       :: Text                        -- ^ String assigned to name field in editor-                     , objectType       :: String+                     , 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          :: Int+                     , objectX          :: Double                        -- ^ x coordinate in pixels-                     , objectY          :: Int+                     , objectY          :: Double                        -- ^ y coordinate in pixels                      , objectRotation   :: Float                        -- ^ Angle in degrees clockwise-                     , objectGid        :: GlobalId+                     , objectGid        :: Maybe GlobalId                        -- ^ GID, only if object comes from a Tilemap                      , objectEllipse    :: Bool                        -- ^ Used to mark an object as an ellipse-                     , objectPolygon    :: Vector (Int, Int)+                     , objectPolygon    :: Maybe (Vector (Double, Double))                        -- ^ A list of x,y coordinates in pixels-                     , objectPolyline   :: Vector (Int, Int)+                     , objectPolyline   :: Maybe (Vector (Double, Double))                        -- ^ A list of x,y coordinates in pixels                      , objectText       :: Map Text Text                        -- ^ String key-value pairs@@ -77,50 +115,51 @@                                   <*> o .: "height"                                   <*> o .: "name"                                   <*> o .: "type"-                                  <*> o .: "properties"+                                  <*> parseDefault o "properties" M.empty                                   <*> o .: "visible"                                   <*> o .: "x"                                   <*> o .: "y"                                   <*> o .: "rotation"-                                  <*> o .: "gid"-                                  <*> o .: "ellipse"-                                  <*> o .: "polygon"-                                  <*> o .: "polyline"-                                  <*> o .: "text"+                                  <*> 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{..} = 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"    .= objectPolygon-                             , "polyline"   .= objectPolyline-                             , "text"       .= objectText-                             ]+  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      :: Int+data Layer = Layer { layerWidth      :: Double                      -- ^ Column count. Same as map width for fixed-size maps.-                   , layerHeight     :: Int+                   , layerHeight     :: Double                      -- ^ Row count. Same as map height for fixed-size maps.-                   , layerName       :: String+                   , layerName       :: Text                      -- ^ Name assigned to this layer-                   , layerType       :: String+                   , layerType       :: Text -- TODO: LayerType                      -- ^ “tilelayer”, “objectgroup”, or “imagelayer”                    , layerVisible    :: Bool                      -- ^ Whether layer is shown or hidden in editor-                   , layerX          :: Int+                   , layerX          :: Double                      -- ^ Horizontal layer offset in tiles. Always 0.-                   , layerY          :: Int+                   , layerY          :: Double                      -- ^ Vertical layer offset in tiles. Always 0.                    , layerData       :: Maybe (Vector GlobalId)                      -- ^ Array of GIDs. tilelayer only.@@ -130,7 +169,7 @@                      -- ^ string key-value pairs.                    , layerOpacity    :: Float                      -- ^ Value between 0 and 1-                   , layerDraworder  :: String+                   , layerDraworder  :: Text -- TODO: DrawOrder                      -- ^ “topdown” (default) or “index”. objectgroup only.                    } deriving (Eq, Generic, Show) @@ -143,29 +182,30 @@                                  <*>  o .: "x"                                  <*>  o .: "y"                                  <*> (o .: "data"       <|> pure Nothing)-                                 <*> (o .: "objects"    <|> 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{..} = 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-                            ]+  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 :: String+data Terrain = Terrain { terrainName :: Text                          -- ^ Name of terrain                        , terrainTile :: LocalId                          -- ^ Local ID of tile representing terrain@@ -189,12 +229,12 @@  instance FromJSON Frame where   parseJSON (A.Object o) = Frame <$> o .: "duration"-                                 <*> o .: "tileId"+                                 <*> o .: "tileid"   parseJSON invalid = typeMismatch "Frame" invalid  instance ToJSON Frame where   toJSON Frame{..} = object [ "duration" .= frameDuration-                            , "tileId"   .= frameTileId+                            , "tileid"   .= frameTileId                             ]  @@ -222,9 +262,9 @@  data Tileset = Tileset { tilesetFirstgid       :: GlobalId                          -- ^ GID corresponding to the first tile in the set-                       , tilesetImage          :: String+                       , tilesetImage          :: FilePath                          -- ^ Image used for tiles in this set-                       , tilesetName           :: String+                       , tilesetName           :: Text                          -- ^ Name given to this tileset                        , tilesetTilewidth      :: Int                          -- ^ Maximum width of tiles in this set@@ -303,29 +343,65 @@                               , "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         :: Float+data Tiledmap = Tiledmap { tiledmapVersion         :: Version                            -- ^ The JSON format version-                         , tiledmapTiledversion    :: String+                         , tiledmapTiledversion    :: Version                            -- ^ The Tiled version used to save the file                          , tiledmapWidth           :: Int                            -- ^ Number of tile columns                          , tiledmapHeight          :: Int                            -- ^ Number of tile rows-                         , tiledmapTilewidth       :: Int+                         , tiledmapTilewidth       :: Double                            -- ^ Map grid width.-                         , tiledmapTileheight      :: Int+                         , tiledmapTileheight      :: Double                            -- ^ Map grid height.-                         , tiledmapOrientation     :: String+                         , tiledmapOrientation     :: Orientation                            -- ^ Orthogonal, isometric, or staggered                          , tiledmapLayers          :: Vector Layer                            -- ^ Array of Layers                          , tiledmapTilesets        :: Vector Tileset                            -- ^ Array of Tilesets-                         , tiledmapBackgroundcolor :: Maybe String+                         , tiledmapBackgroundcolor :: Maybe Text                            -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)-                         , tiledmapRenderorder     :: String+                         , tiledmapRenderorder     :: Text -- TODO: RenderOrder                            -- ^ Rendering direction (orthogonal maps only)                          , tiledmapProperties      :: Map Text Text                            -- ^ String key-value pairs

@@ -0,0 +1,22 @@+{-# 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+

@@ -0,0 +1,26 @@+{-# 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,24 +1,1 @@-{-# LANGUAGE LambdaCase #-}-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"-        ]--main :: IO ()-main = hspec $ forM_ files $ \file ->-  describe ("With " ++ show file) $-    it "loading and encoding and decoding should end up with the same Tiledmap" $-      loadTiledmap file >>= \case-        Right tm -> do-          let bs = encode tm-          eitherDecode bs `shouldBe` Right tm-        _ -> fail $ "Could not decode Tiledmap from " ++ show file+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}