diff options
author | Joey Hess <joeyh@joeyh.name> | 2018-04-16 15:42:45 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2018-04-16 16:21:21 -0400 |
commit | 89e1a05a8f62ac6ac3ae3f24be0165fe1fcc6f75 (patch) | |
tree | d6362324567527598f6fbdeb3bea15832bc557d5 /Types | |
parent | 6ddd374935f4bed713f394d9c9026c4d09353d67 (diff) |
Fix mangling of --json output of utf-8 characters when not running in a utf-8 locale
As long as all code imports Utility.Aeson rather than Data.Aeson,
and no Strings that may contain utf-8 characters are used for eg, object
keys via T.pack, this is guaranteed to fix the problem everywhere that
git-annex generates json.
It's kind of annoying to need to wrap ToJSON with a ToJSON', especially
since every data type that has a ToJSON instance has to be ported over.
However, that only took 50 lines of code, which is worth it to ensure full
coverage. I initially tried an alternative approach of a newtype FileEncoded,
which had to be used everywhere a String was fed into aeson, and chasing
down all the sites would have been far too hard. Did consider creating an
intentionally overlapping instance ToJSON String, and letting ghc fail
to build anything that passed in a String, but am not sure that wouldn't
pollute some library that git-annex depends on that happens to use ToJSON
String internally.
This commit was supported by the NSF-funded DataLad project.
Diffstat (limited to 'Types')
-rw-r--r-- | Types/Messages.hs | 2 | ||||
-rw-r--r-- | Types/MetaData.hs | 12 |
2 files changed, 7 insertions, 7 deletions
diff --git a/Types/Messages.hs b/Types/Messages.hs index d45174bb71..8ca60651f6 100644 --- a/Types/Messages.hs +++ b/Types/Messages.hs @@ -9,7 +9,7 @@ module Types.Messages where -import qualified Data.Aeson as Aeson +import qualified Utility.Aeson as Aeson import Control.Concurrent #ifdef WITH_CONCURRENTOUTPUT diff --git a/Types/MetaData.hs b/Types/MetaData.hs index 279aacbb84..e05a8f72ec 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -43,6 +43,7 @@ module Types.MetaData ( import Common import Utility.Base64 import Utility.QuickCheck +import Utility.Aeson import qualified Data.Text as T import qualified Data.Set as S @@ -50,15 +51,14 @@ import qualified Data.Map as M import qualified Data.HashMap.Strict as HM import Data.Char import qualified Data.CaseInsensitive as CI -import Data.Aeson newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue)) deriving (Show, Eq, Ord) -instance ToJSON MetaData where - toJSON (MetaData m) = object $ map go (M.toList m) +instance ToJSON' MetaData where + toJSON' (MetaData m) = object $ map go (M.toList m) where - go (MetaField f, s) = (T.pack (CI.original f), toJSON s) + go (MetaField f, s) = (packString (CI.original f), toJSON' s) instance FromJSON MetaData where parseJSON (Object o) = do @@ -82,8 +82,8 @@ newtype MetaField = MetaField (CI.CI String) data MetaValue = MetaValue CurrentlySet String deriving (Read, Show) -instance ToJSON MetaValue where - toJSON (MetaValue _ v) = toJSON v +instance ToJSON' MetaValue where + toJSON' (MetaValue _ v) = toJSON' v instance FromJSON MetaValue where parseJSON (String v) = return $ MetaValue (CurrentlySet True) (T.unpack v) |