summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/CheckMap.hs7
-rw-r--r--lib/Tiled2.hs45
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