diff options
| -rw-r--r-- | lib/Badges.hs | 11 | ||||
| -rw-r--r-- | lib/CheckDir.hs | 11 |
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 |