fixed & removed a bunch of old TODOs

7 files changed, 50 insertions, 32 deletions

diff --git a/lib/Badges.hs b/lib/Badges.hs
index efb4e77..65433a1 100644
--- a/lib/Badges.hs
+++ b/lib/Badges.hs
@@ -22,10 +22,10 @@ data BadgeArea =
    , areaY :: Double
    }
  | BadgeRect
-   { areaX         :: Double
-   , areaY         :: Double
-   , areaWidth     :: Double
-   , areaHeight    :: Double
+   { areaX      :: Double
+   , areaY      :: Double
+   , areaWidth  :: Double
+   , areaHeight :: Double
    }
   deriving (Ord, Eq, Generic, Show)
 
@@ -41,7 +41,7 @@ instance ToJSON BadgeToken where
   toJSON (BadgeToken text) = toJSON text
 
 parseToken :: Text -> Maybe BadgeToken
-parseToken text = if text =~ ("^[a-zA-Z0-9]{50}$" :: Text) -- TODO: add character limit
+parseToken text = if text =~ ("^[a-zA-Z0-9]{50}$" :: Text)
   then Just (BadgeToken text)
   else Nothing
 
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 779123d..0fe76ba 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -61,9 +61,6 @@ instance ToJSON MapResult where
     [ "layer" .= CollectedLints (fmap getName <$> mapresultLayer res)
     , "tileset" .= CollectedLints (fmap getName <$> mapresultTileset res)
     , "general" .= mapresultGeneral res
-    -- TODO: not sure if these are necessary of even useful
-    --, "depends" .= mapresultDepends res
-    --, "provides" .= mapresultProvides res
     ]
 
 newtype CollectedLints = CollectedLints (Map Hint [Text])
diff --git a/lib/Paths.hs b/lib/Paths.hs
index 99774c5..7fae0df 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -36,9 +36,10 @@ parsePath text =
     -- how many steps upwards in the tree?
     up = length . filter (".." ==) . T.splitOn  "/" $ prefix
     parts = T.splitOn "#" rest
+    -- `head` is unsafe, but splitOn will always produce lists with at least one element
     path = head parts
     fragment = if length parts >= 2
-      then Just $ T.concat $ tail parts -- TODO!
+      then Just $ T.concat $ tail parts
       else Nothing
 
 instance PrettyPrint RelPath where
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 9c61aed..6a8c166 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -130,7 +130,6 @@ checkMapProperty p@(Property name _) = case name of
 checkTileset ::  LintWriter Tileset
 checkTileset = do
   tileset <- askContext
-  -- TODO: can tilesets be non-local dependencies?
   unwrapPath (tilesetImage tileset) (dependsOn . Local)
 
   refuseDoubledNames (getProperties tileset)
@@ -154,8 +153,16 @@ checkTileset = do
   -- check individual tileset properties
   mapM_ checkTilesetProperty (fromMaybe mempty $ tilesetProperties tileset)
 
-  -- check individual tile definitions
-  mapM_ checkTile (fromMaybe mempty $ tilesetTiles tileset)
+  case tilesetTiles tileset of
+    Nothing -> pure ()
+    Just tiles -> do
+      -- can't set properties on the same tile twice
+      refuseDoubledThings tileId
+        (\tile -> complain $ "cannot set properties on the \
+                  \tile with the id" <> showText (tileId tile) <> "twice.")
+        tiles
+
+      mapM_ checkTile tiles
   where
     checkTilesetProperty :: Property -> LintWriter Tileset
     checkTilesetProperty p@(Property name _value) = case name of
@@ -164,8 +171,8 @@ checkTileset = do
 
     checkTile :: Tile -> LintWriter Tileset
     checkTile tile = do
-      -- TODO:  refused doubled IDs?
-      mapM_ checkTileProperty (fromMaybe mempty $ tileProperties tile)
+      refuseDoubledNames (getProperties tile)
+      mapM_ checkTileProperty (getProperties tile)
       where checkTileProperty :: Property -> LintWriter Tileset
             checkTileProperty p@(Property name _) = case name of
               "collides" -> isBool p
@@ -401,22 +408,30 @@ refuseDoubledNames
   => (Foldable t, Functor t)
   => t a
   -> LintWriter b
-refuseDoubledNames things = foldr folding base things (mempty,mempty)
+refuseDoubledNames = refuseDoubledThings
+  getName
+  (\thing -> complain $ "cannot use " <> typeName (mkProxy thing) <> " name "
+                     <> getName thing <> " multiple times.")
+
+-- | refuse doubled things via equality on after applying some function
+refuseDoubledThings
+  :: (Eq a, Ord a, Foldable t, Functor t)
+  => (a' -> a)
+  -> (a' -> LintWriter b)
+  -> t a'
+  -> LintWriter b
+refuseDoubledThings f ifDouble things = foldr folding base things (mempty, mempty)
   where
-    -- this accumulates a function that complains about things it's
-    -- already seen, except if they've already occured twice and then
-    -- occur again …
     folding thing cont (seen, twice)
-      | name `elem` seen && name `notElem` twice = do
-        complain $ "cannot use " <> typeName (mkProxy thing)
-                  <> " name \"" <> name <> "\" multiple times."
-        cont (seen, S.insert name twice)
+      | f thing `elem` seen && f thing `notElem` twice = do
+        ifDouble thing
+        cont (seen, S.insert (f thing) twice)
       | otherwise =
-        cont (S.insert name seen, twice)
-      where name = getName thing
+        cont (S.insert (f thing) seen, twice)
     base _ = pure ()
 
 
+
 ---- General functions ----
 
 unlessElement
diff --git a/lib/Tiled.hs b/lib/Tiled.hs
index a092b67..fa876ee 100644
--- a/lib/Tiled.hs
+++ b/lib/Tiled.hs
@@ -52,7 +52,6 @@ mkTiledId i = GlobalId { unGlobalId = i }
 newtype LocalId = LocalId { unLocalId :: Int }
   deriving (Ord, Eq, Enum, Num, Generic, Show, FromJSON, ToJSON, FromJSONKey, ToJSONKey)
 
--- | TODO: type-check colours?
 type Color = Text
 
 -- | A custom tiled property, which just has a name and a value.
diff --git a/lib/TiledAbstract.hs b/lib/TiledAbstract.hs
index f7bbbb9..88dd2ee 100644
--- a/lib/TiledAbstract.hs
+++ b/lib/TiledAbstract.hs
@@ -2,11 +2,12 @@
 
 module TiledAbstract where
 
-import           Data.Maybe (fromMaybe)
-import           Data.Proxy (Proxy)
-import           Data.Text  (Text)
-import           Tiled      (Layer (..), Property (..), PropertyValue (..),
-                             Tiledmap (..), Tileset (..))
+import           Data.Maybe  (fromMaybe)
+import           Data.Proxy  (Proxy)
+import           Data.Text   (Text)
+import qualified Data.Vector as V
+import           Tiled       (Layer (..), Property (..), PropertyValue (..),
+                              Tile (..), Tiledmap (..), Tileset (..))
 
 class HasProperties a where
   getProperties :: a -> [Property]
@@ -22,6 +23,12 @@ instance HasProperties Tileset where
   adjustProperties f tileset = tileset
     { tilesetProperties = f (getProperties tileset) }
 
+instance HasProperties Tile where
+  getProperties = V.toList . fromMaybe mempty . tileProperties
+  adjustProperties f tile = tile
+    { tileProperties = (fmap V.fromList . f) (getProperties tile) }
+
+
 instance HasProperties Tiledmap where
   getProperties = fromMaybe mempty . tiledmapProperties
   adjustProperties f tiledmap = tiledmap
diff --git a/lib/Types.hs b/lib/Types.hs
index 6f80d55..978ada2 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -51,7 +51,6 @@ instance HasArguments Level where
 data Lint = Depends Dep | Offers Text | Lint Hint | Badge Badge
   deriving (Ord, Eq, Generic, ToJSONKey)
 
--- | TODO: add a reasonable representation of possible urls
 data Dep = Local RelPath | Link Text | MapLink Text | LocalMap RelPath
   deriving (Generic, Ord, Eq)
 
@@ -84,7 +83,7 @@ instance PrettyPrint Lint where
     "  Info: found a badge."
 
 instance PrettyPrint Hint where
-  prettyprint (Hint level msg) = "  " <> (showText level) <> ": " <> msg
+  prettyprint (Hint level msg) = "  " <> showText level <> ": " <> msg
 
 instance ToJSON Lint where
   toJSON (Lint h) = toJSON h