summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorstuebinm2021-09-05 19:10:30 +0200
committerstuebinm2021-09-05 19:10:30 +0200
commit0787b24786a329dae5f25c1cd2916ce962471f1d (patch)
treedde1c972930cbc25385c60af3d8cd5a1d2f8319d /src
simple proof of concept
Lots of monads everywhere, hurray! (unfortunately, workadventure maps don't quite form a category; they lack composition …) Credits: - the example.json file is by TabascoEye (with some modifications for testing purposes) - the Tiled module is forked from aeson-tiled on hackage, since that package didn't handle custom layer properties correctly
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs191
-rw-r--r--src/Tiled2.hs400
2 files changed, 591 insertions, 0 deletions
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..c5787db
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,191 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Main where
+
+import Data.Map (Map, (!?))
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Maybe (isJust, mapMaybe)
+import qualified Data.Aeson as Aeson
+import Data.Vector (Vector)
+import Data.Set (Set, fromList)
+import qualified Data.Vector as V
+import Control.Monad.Writer
+import Control.Monad.Trans.Maybe
+
+import Tiled2
+
+data Level = Warning | Suggestion | Info | Forbidden | Error
+ deriving Show
+
+data Hint = Hint
+ { hintLevel :: Level
+ , hintMsg :: Text }
+ deriving Show
+
+-- shorter constructors
+suggestion msg = Hint { hintLevel = Suggestion, hintMsg = msg }
+warning msg = Hint { hintLevel = Warning, hintMsg = msg }
+forbidden msg = Hint { hintLevel = Forbidden, hintMsg = msg }
+
+
+-- | converts a Maybe to an Either, with a default value for Left
+unwrap :: b -> Maybe a -> Either b a
+unwrap hint maybe = case maybe of
+ Just a -> Right a
+ Nothing -> Left hint
+
+-- | unwrap and produce a warning if the value was Nothing
+unwrapWarn :: Text -> Maybe a -> Either Hint a
+unwrapWarn msg = unwrap $ warning msg
+
+-- | get an attribute from a map
+getAttr :: Map Text Aeson.Value -> Text -> Either Hint Aeson.Value
+getAttr props name = unwrapWarn msg $ props !? name
+ where msg = "field " <> name <> "does not exist"
+
+-- | same as unwrapWarn, but for booleans
+assertWarn :: Text -> Bool -> Either Hint ()
+assertWarn msg cond = if cond then Right () else Left $ warning msg
+
+-- | haskell's many string types are FUN …
+showText :: Show a => a -> Text
+showText = T.pack . show
+
+-- | same as showText, but without the "String"-prefix for strings
+-- TODO: serialise back into json for printing? People may get
+-- confused by the type annotations if they only know json …
+showAeson :: Aeson.Value -> Text
+showAeson (Aeson.String s) = showText s
+showAeson v = showText v
+
+-- | the given property should have the given value. Otherwise, warning.
+propEqual :: Map Text Aeson.Value -> Text -> Aeson.Value -> Either Hint ()
+propEqual props name value = do
+ value' <- getAttr props name
+ assertWarn ("field "<>name<>" has unexpected value "<>showAeson value'
+ <>", should be "<>showAeson value)
+ $ value' == value
+
+-- |
+-- This type may require some explanation.
+-- Essentially, it's a monad that can short-curcuit (i.e. abort),
+-- and also collect hints as it goes. Currently, both aborts and
+-- hints are the same type (Hint); if the monad ends up returning
+-- Left Hint, then something went entirely wrong; if it returns
+-- Right (a, [Hint]), then it ran through, calculated a, and collected
+-- a list of linter hints along the way.
+type MaybeWriter a = WriterT [Hint] (Either Hint) a
+
+
+-- | type juggling to get a single warning into MaybeWriter a
+maybeWriterHint :: (Text -> Hint) -> Text -> MaybeWriter ()
+maybeWriterHint constructor = tell . (: []) . constructor
+
+warn = maybeWriterHint warning
+info = maybeWriterHint (\t -> Hint { hintLevel = Info, hintMsg = t })
+forbid = maybeWriterHint forbidden
+suggest = maybeWriterHint suggestion
+complain = maybeWriterHint (\t -> Hint { hintLevel = Error, hintMsg = t })
+
+-- | adds quotes (but does not escape, for now!)
+quote :: Text -> Text
+quote text = "\"" <> text <> "\""
+
+-- | does this layer have the given property?
+hasProperty :: Text -> Layer -> Bool
+hasProperty name = any
+ (\prop -> prop !? "name" == Just (Aeson.String name))
+ . layerProperties
+
+
+
+-- | The main thing
+--
+-- given a property, check if it is valid. It gets a reference
+-- to its own layer since sometimes the presense of one property
+-- implies the presence or absense of another.
+--
+-- The tests in here are meant to comply with the informal spec
+-- at https://workadventu.re/map-building
+checkProperty :: Layer -> Map Text Aeson.Value -> MaybeWriter ()
+checkProperty layer prop = do
+ tyObj <- lift $ getAttr prop "name"
+ ty <- lift $ case tyObj of
+ Aeson.String str -> Right str
+ _ -> Left (suggestion "wtf")
+ checkTyped ty
+ where checkTyped ty = case ty of
+ "jitsiRoom" -> do
+ lift $ propEqual prop "type" "string"
+ urlValue <- lift $ getAttr prop "value"
+ info $ "found jitsi room: " <> showAeson urlValue
+ suggestPropertyValue "jitsiTrigger" "onaction"
+ forbidProperty "jitsiUrl"
+ -- TODO: not sure if we should really disallow these entirely
+ forbidProperty "jitsiConfig"
+ forbidProperty "jitsiClientConfig"
+ forbidProperty "jitsiRoomAdminTag"
+ "jitsiTrigger" -> requireProperty "jitsiRoom"
+ "playAudio" -> do
+ -- TODO: check for url validity?
+ lift $ propEqual prop "type" "string"
+ "audioLoop" -> requireProperty "playAudio"
+ "audioVolume" -> requireProperty "playAudio"
+ "openWebsite" -> suggestPropertyValue "openWebsiteTrigger" "onaction"
+ "openWebsiteTrigger" -> requireProperty "openWebsite"
+ "openWebsitePolicy" -> requireProperty "openWebsite"
+ "exitUrl" -> return ()
+ "startLayer" -> return ()
+ -- could also make this a "hard error" (i.e. Left), but then it
+ -- stops checking other properties as checkLayer short-circuits.
+ _ -> warn $ "unknown property type " <> quote ty
+ where
+ -- | require some property in this layer
+ requireProperty name = unless (hasProperty name layer)
+ $ complain $ "property "<>quote name<>" requires property "<>quote ty
+ -- | forbid some property in this layer
+ forbidProperty name = when (hasProperty name layer)
+ $ forbid $ "property " <> quote name <> " should not be used"
+ -- TODO: check if the property has the correct value
+ suggestPropertyValue name value = unless (hasProperty name layer)
+ $ suggest $ "set property " <> quote name <> " to " <> quote value
+
+checkLayer :: Layer -> MaybeWriter ()
+checkLayer layer =
+ mapM_ (checkProperty layer) (layerProperties layer)
+
+-- TODO: possibly expand this to something more detailed?
+showContext :: Text -> Text
+showContext ctxt = " (in layer " <> ctxt <> ")\n"
+
+-- | pretty-printer for a result of WriterMaybe (currently only for errors/hints)
+showResult :: Show a => Text -> Either Hint (a, [Hint]) -> Maybe Text
+showResult ctxt (Left hint) = Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
+showResult _ (Right (a, [])) = Nothing
+showResult ctxt (Right (a, hints)) = Just $ showHints hints
+ where
+ showHints hints = T.concat (mapMaybe showHint hints)
+ -- TODO: make the "log level" configurable
+ showHint Hint { hintMsg, hintLevel } = case hintLevel of
+ Info -> Nothing
+ _ -> Just $ showText hintLevel <> ": " <> hintMsg <> ctxtHint
+ ctxtHint = showContext ctxt
+
+
+
+main :: IO ()
+main = do
+ Right map <- loadTiledmap "example.json"
+ --print $ mapJitsiUrls map
+ --print $ fmap layerJitsiUrls (tiledmapLayers map)
+ -- TODO: print the layer each hint originates from
+ let lines = V.mapMaybe (\layer ->
+ (showResult (T.pack $ layerName layer)
+ . runWriterT
+ . checkLayer)
+ layer)
+ (tiledmapLayers map)
+ mapM_ T.putStr lines
diff --git a/src/Tiled2.hs b/src/Tiled2.hs
new file mode 100644
index 0000000..17b2b77
--- /dev/null
+++ b/src/Tiled2.hs
@@ -0,0 +1,400 @@
+{-# 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 Tiled2 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
+
+parseDefault :: FromJSON a => A.Object -> Text -> a -> Parser a
+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 :: String
+ -- ^ String assigned to name field in editor
+ , objectType :: String
+ -- ^ 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 :: String
+ -- ^ Name assigned to this layer
+ , layerType :: String
+ -- ^ “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 Value]
+ -- ^ string key-value pairs.
+ , layerOpacity :: Float
+ -- ^ Value between 0 and 1
+ , layerDraworder :: String
+ -- ^ “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 :: String
+ -- ^ 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 :: String
+ -- ^ Image used for tiles in this set
+ , tilesetName :: String
+ -- ^ 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
+ ]
+
+
+-- | The full monty.
+data Tiledmap = Tiledmap { tiledmapVersion :: Float
+ -- ^ The JSON format version
+ , tiledmapTiledversion :: String
+ -- ^ 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 :: String
+ -- ^ Orthogonal, isometric, or staggered
+ , tiledmapLayers :: Vector Layer
+ -- ^ Array of Layers
+ , tiledmapTilesets :: Vector Tileset
+ -- ^ Array of Tilesets
+ , tiledmapBackgroundcolor :: Maybe String
+ -- ^ Hex-formatted color (#RRGGBB or #AARRGGBB) (optional)
+ , tiledmapRenderorder :: String
+ -- ^ 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