From 9812d9aaec57ec28f221b219dd6fbbe521370107 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 10 May 2023 13:30:43 -0400 Subject: [PATCH] support aeson for Map Make unused --json use it, which is better than the doubly nested lists it was using. Sponsored-By: the NIH-funded NICEMAN (ReproNim TR&D3) project --- Command/Unused.hs | 3 ++- Utility/Aeson.hs | 8 +++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/Command/Unused.hs b/Command/Unused.hs index 544f0da327..37566cb677 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -40,6 +40,7 @@ import qualified Data.Map as M import qualified Data.Vector as V import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 +import qualified Data.Text as T import Data.Char cmd :: Command @@ -116,7 +117,7 @@ check fileprefix msg a c = do showLongNote $ UnquotedString $ msg unusedlist maybeAddJSONField ((if null fileprefix then "unused" else fileprefix) ++ "-list") - (V.fromList $ map (\(n, k) -> (show n, serializeKey k)) unusedlist) + (M.fromList $ map (\(n, k) -> (T.pack (show n), serializeKey k)) unusedlist) updateUnusedLog (toRawFilePath fileprefix) (M.fromList unusedlist) return $ c + length l diff --git a/Utility/Aeson.hs b/Utility/Aeson.hs index 9e126c82dd..0eacbf0daa 100644 --- a/Utility/Aeson.hs +++ b/Utility/Aeson.hs @@ -2,7 +2,7 @@ - - Import instead of Data.Aeson - - - Copyright 2018-2019 Joey Hess + - Copyright 2018-2023 Joey Hess - - License: BSD-2-clause -} @@ -33,6 +33,7 @@ import qualified Data.Text.Encoding as T import qualified Data.ByteString.Lazy as L import qualified Data.ByteString as S import qualified Data.Set +import qualified Data.Map import qualified Data.Vector import Prelude @@ -100,6 +101,11 @@ instance ToJSON' s => ToJSON' (Data.Vector.Vector s) where instance ToJSON' s => ToJSON' (Data.Set.Set s) where toJSON' = toJSON . map toJSON' . Data.Set.toList +instance (ToJSON' v) => ToJSON' (Data.Map.Map T.Text v) where + toJSON' m = object $ map go (Data.Map.toList m) + where + go (k, v) = (textKey k, toJSON' v) + instance (ToJSON' a, ToJSON a) => ToJSON' (Maybe a) where toJSON' (Just a) = toJSON (Just (toJSON' a)) toJSON' v@Nothing = toJSON v -- 2.30.2