diff options
| -rw-r--r-- | lib/CheckMap.hs | 7 | ||||
| -rw-r--r-- | lib/Tiled2.hs | 45 |
2 files changed, 11 insertions, 41 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 35c00a1..41f251e 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -20,15 +20,12 @@ import qualified Data.Vector as V import GHC.Generics (Generic) -import Data.Bifunctor (Bifunctor (second)) import Data.Functor ((<&>)) import LintWriter (filterLintLevel, invertLintResult, lintToDep, resultToAdjusted, resultToDeps, resultToLints, resultToOffers, runLintWriter) import Properties (checkLayer, checkMap, checkTileset) -import Tiled2 (HasName (getName), - HasProperties (getProperties), Layer, - LoadResult (..), +import Tiled2 (HasName (getName), Layer, LoadResult (..), Tiledmap (tiledmapLayers, tiledmapTilesets), Tileset, loadTiledmap) import Types (Dep, Hint (hintLevel, hintMsg), Level (..), @@ -90,7 +87,7 @@ runLinter tiledmap depth = MapResult { mapresultLayer = invertThing layer , mapresultTileset = invertThing tileset , mapresultGeneral = resultToLints generalResult - , mapresultDepends = mapMaybe lintToDep generalLints + , mapresultDepends = mapMaybe lintToDep (resultToLints generalResult) <> concatMap resultToDeps layer <> concatMap resultToDeps tileset , mapresultProvides = concatMap resultToOffers layer diff --git a/lib/Tiled2.hs b/lib/Tiled2.hs index e281d00..efa8a07 100644 --- a/lib/Tiled2.hs +++ b/lib/Tiled2.hs @@ -18,7 +18,7 @@ import Control.Exception (try) import Control.Exception.Base (SomeException) import Data.Aeson hiding (Object) import qualified Data.Aeson as A -import Data.Aeson.Types (Parser, typeMismatch) +import Data.Aeson.Types (typeMismatch) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LB import Data.Char (toLower) @@ -28,7 +28,6 @@ import Data.String (IsString (fromString)) import Data.Text (Text) import qualified Data.Text as T import Data.Vector (Vector) -import GHC.Exts (IsString, fromList, toList) import GHC.Generics (Generic) @@ -55,41 +54,15 @@ newtype LocalId = LocalId { unLocalId :: Int } -- | TODO: type-check colours? type Color = Text -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 - +-- | A custom tiled property, which just has a name and a value. +data Property = Property Text PropertyValue + deriving (Eq, Generic, Show) +-- | The value of a custom tiled property. +-- It is strongly typed via a tag in the json representation, +-- and needs a custom ToJSON and FromJSON instance because of that. data PropertyValue = StrProp Text | BoolProp Bool deriving (Eq, Generic, Show) -data Property = Property Text PropertyValue - deriving (Eq, Generic, Show) instance IsString PropertyValue where fromString s = StrProp (T.pack s) @@ -374,6 +347,6 @@ loadTiledmap path = do res <- try (BS.readFile path) pure $ case res of Right file -> case eitherDecode . LB.fromStrict $ file of - Left err -> DecodeErr err - Right map -> Loaded map + Left err -> DecodeErr err + Right tiledmap -> Loaded tiledmap Left (err :: SomeException) -> IOErr $ show err |