change badge output formatstructured-badges

(following a discussion with hxchn)

2 files changed, 7 insertions, 15 deletions

diff --git a/lib/Badges.hs b/lib/Badges.hs
index efb4e77..5019a88 100644
--- a/lib/Badges.hs
+++ b/lib/Badges.hs
@@ -48,20 +48,17 @@ parseToken text = if text =~ ("^[a-zA-Z0-9]{50}$" :: Text) -- TODO: add characte
 data Badge = Badge BadgeToken BadgeArea
   deriving (Ord, Eq, Generic, Show)
 
-badgeJsonArray :: A.KeyValue a => Badge -> [a]
-badgeJsonArray (Badge token area) =
-  [ "token" .= token ] <> areaObject
-  where areaObject = case area of
+instance ToJSON Badge where
+  toJSON (Badge token area) = A.object $ case area of
          BadgePoint x y -> [ "x" .= x
                            , "y" .= y
+                           , "token" .= token
                            , "type" .= A.String "point"
                            ]
          BadgeRect {..} -> [ "x" .= areaX
                            , "y" .= areaY
+                           , "token" .= token
                            , "width" .= areaWidth
                            , "height" .= areaHeight
                            , "type" .= A.String "rectangle"
                            ]
-
-badgeJson :: FilePath -> Badge -> A.Value
-badgeJson mappath badge = A.object (badgeJsonArray badge <> [ "map" .= mappath ])
diff --git a/lib/CheckDir.hs b/lib/CheckDir.hs
index 3336ff9..8a854e6 100644
--- a/lib/CheckDir.hs
+++ b/lib/CheckDir.hs
@@ -9,7 +9,6 @@
 -- | Module that contains high-level checking for an entire directory
 module CheckDir (recursiveCheckDir, DirResult(..), resultIsFatal)  where
 
-import           Badges                 (badgeJson)
 import           CheckMap               (MapResult (..), loadAndLintMap)
 import           Control.Monad          (void)
 import           Control.Monad.Extra    (mapMaybeM)
@@ -17,7 +16,7 @@ import           Data.Aeson             (ToJSON, (.=))
 import qualified Data.Aeson             as A
 import           Data.Foldable          (fold)
 import           Data.Functor           ((<&>))
-import           Data.Map               (Map, elems, keys, mapWithKey)
+import           Data.Map               (Map, elems, keys)
 import qualified Data.Map               as M
 import           Data.Map.Strict        (mapKeys, (\\))
 import           Data.Maybe             (mapMaybe)
@@ -95,13 +94,9 @@ instance ToJSON DirResult where
       ]
     , "resultText" .= prettyprint (Suggestion, res)
     , "severity" .= maximumLintLevel res
-    , "badges" .= annotatedBadges
-    , "maps" .= M.keys (dirresultMaps res)
+    , "mapInfo" .= fmap (\tm -> A.object [ "badges" .= mapresultBadges tm ])
+                        (dirresultMaps res)
     ]
-    where annotatedBadges = concat
-            . M.elems
-            . mapWithKey (\k -> fmap (badgeJson k) . mapresultBadges)
-            $ dirresultMaps res
 
 instance ToJSON MissingAsset where
   toJSON (MissingAsset md) = A.object