diff options
Diffstat (limited to '')
| -rw-r--r-- | tiled/Data/Tiled.hs | 65 | ||||
| -rw-r--r-- | tiled/Data/Tiled/Abstract.hs | 6 | ||||
| -rw-r--r-- | tiled/Data/Tiled/TH.hs | 15 |
3 files changed, 31 insertions, 55 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) diff --git a/tiled/Data/Tiled/Abstract.hs b/tiled/Data/Tiled/Abstract.hs index 89c40b4..29e9022 100644 --- a/tiled/Data/Tiled/Abstract.hs +++ b/tiled/Data/Tiled/Abstract.hs @@ -4,9 +4,9 @@ module Data.Tiled.Abstract where import Universum -import Data.Tiled (GlobalId, Layer (..), Object (..), Property (..), +import Data.Tiled (GlobalId (..), Layer (..), Object (..), Property (..), PropertyValue (..), Tile (..), Tiledmap (..), - Tileset (..), mkTiledId) + Tileset (..)) import qualified Data.Vector as V class HasProperties a where @@ -81,4 +81,4 @@ instance IsProperty Text where layerIsEmpty :: HasData a => a -> Bool layerIsEmpty layer = case getData layer of Nothing -> True - Just d -> all ((==) $ mkTiledId 0) d + Just d -> all ((==) $ GlobalId 0) d diff --git a/tiled/Data/Tiled/TH.hs b/tiled/Data/Tiled/TH.hs new file mode 100644 index 0000000..e0ad0e8 --- /dev/null +++ b/tiled/Data/Tiled/TH.hs @@ -0,0 +1,15 @@ +module Data.Tiled.TH where + +import Universum + +import qualified Data.Aeson.TH as TH +import Data.Char (toLower) + +aesonOptions :: Int -> TH.Options +aesonOptions l = TH.defaultOptions + { TH.omitNothingFields = True + , TH.rejectUnknownFields = True + -- can't be bothered to do a nicer prefix strip + , TH.fieldLabelModifier = drop l . map toLower + , TH.sumEncoding = TH.UntaggedValue + } |