diff options
Diffstat (limited to 'tiled/Data/Tiled.hs')
| -rw-r--r-- | tiled/Data/Tiled.hs | 65 |
1 files changed, 13 insertions, 52 deletions
diff --git a/tiled/Data/Tiled.hs b/tiled/Data/Tiled.hs index 3e6c737..4372a97 100644 --- a/tiled/Data/Tiled.hs +++ b/tiled/Data/Tiled.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} @@ -9,6 +8,9 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} + + -- | 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/. @@ -23,27 +25,15 @@ import Universum import Data.Aeson hiding (Object) import qualified Data.Aeson as A import Data.Aeson.Types (typeMismatch) -import Data.Char (toLower) +import Data.Aeson.TH (deriveJSON) import Control.Exception (IOException) +import Data.Tiled.TH --- | options for Aeson's generic encoding and parsing functions -aesonOptions :: Int -> Options -aesonOptions l = defaultOptions - { omitNothingFields = True - , rejectUnknownFields = True - -- can't be bothered to do a nicer prefix strip - , fieldLabelModifier = drop l . map toLower - , sumEncoding = UntaggedValue - } - -- | A globally indexed identifier. newtype GlobalId = GlobalId { unGlobalId :: Int } deriving newtype (Ord, Eq, Enum, Num, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey, NFData) -mkTiledId :: Int -> GlobalId -mkTiledId i = GlobalId { unGlobalId = i } - -- | A locally indexed identifier. newtype LocalId = LocalId { unLocalId :: Int } deriving newtype (Ord, Eq, Enum, Num, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey, NFData) @@ -109,11 +99,6 @@ data Point = Point { pointX :: Double , pointY :: Double } deriving (Eq, Generic, Show, NFData) -instance FromJSON Point where - parseJSON = genericParseJSON (aesonOptions 5) -instance ToJSON Point where - toJSON = genericToJSON (aesonOptions 5) - -- | all kinds of objects that can occur in object layers, even -- | those that we don't want to allow. @@ -177,15 +162,6 @@ data Object = ObjectRectangle } deriving (Eq, Generic, Show, NFData) - - - -instance FromJSON Object where - parseJSON = genericParseJSON (aesonOptions 6) -instance ToJSON Object where - toJSON = genericToJSON (aesonOptions 6) - - data Layer = Layer { layerWidth :: Maybe Double -- ^ Column count. Same as map width for fixed-size maps. , layerHeight :: Maybe Double @@ -224,11 +200,6 @@ data Layer = Layer { layerWidth :: Maybe Double , layerColor :: Maybe Color } deriving (Eq, Generic, Show, NFData) -instance FromJSON Layer where - parseJSON = genericParseJSON (aesonOptions 5) -instance ToJSON Layer where - toJSON = genericToJSON (aesonOptions 5) - data Terrain = Terrain { terrainName :: String -- ^ Name of terrain @@ -275,13 +246,6 @@ data Tile = Tile { tileId :: Int , tileTerrain :: Maybe [Int] } deriving (Eq, Generic, Show, NFData) -instance FromJSON Tile where - parseJSON = genericParseJSON (aesonOptions 4) - -instance ToJSON Tile where - toJSON = genericToJSON (aesonOptions 4) - - data Tileset = Tileset { tilesetFirstgid :: GlobalId -- ^ GID corresponding to the first tile in the set @@ -332,13 +296,6 @@ data Tileset = Tileset { tilesetFirstgid :: GlobalId newtype TransitiveTilesetMap = TransitiveTilesetMap (Map LocalId Value) deriving newtype (Show, Eq, FromJSON) -instance FromJSON Tileset where - parseJSON = genericParseJSON (aesonOptions 7) - -instance ToJSON Tileset where - toJSON = genericToJSON (aesonOptions 7) - - -- | The full monty. data Tiledmap = Tiledmap { tiledmapVersion :: Value -- ^ The JSON format version @@ -376,10 +333,14 @@ data Tiledmap = Tiledmap { tiledmapVersion :: Value , tiledmapEditorsettings :: Maybe Value } deriving (Eq, Generic, Show, NFData) -instance FromJSON Tiledmap where - parseJSON = genericParseJSON (aesonOptions 8) -instance ToJSON Tiledmap where - toJSON = genericToJSON (aesonOptions 8) + +$(deriveJSON (aesonOptions 5) ''Point) +$(deriveJSON (aesonOptions 6) ''Object) +$(deriveJSON (aesonOptions 5) ''Layer) +$(deriveJSON (aesonOptions 4) ''Tile) +$(deriveJSON (aesonOptions 7) ''Tileset) +$(deriveJSON (aesonOptions 8) ''Tiledmap) + -- | Load a Tiled map from the given 'FilePath'. loadTiledmap :: FilePath -> IO (Either String Tiledmap) |