Skip to content
Snippets Groups Projects
Commit 47dd2e5f authored by stuebinm's avatar stuebinm Committed by Rehlein
Browse files

change badge output format

(following a discussion with hxchn)
parent 5b3cb907
Branches
Tags
No related merge requests found
Pipeline #9976 failed
......@@ -48,20 +48,17 @@ parseToken text = if text =~ ("^[a-zA-Z0-9]{50}$" :: Text)
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 ])
......@@ -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)
......@@ -102,13 +101,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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment