factor out Utility.Aeson.textKey
This commit is contained in:
parent
a314a8dfd0
commit
cbd138e042
4 changed files with 17 additions and 36 deletions
|
@ -34,7 +34,6 @@ import qualified Data.Map as M
|
|||
import qualified Data.Vector as V
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
import qualified Data.Aeson.Key as AK
|
||||
import qualified Data.Aeson.KeyMap as HM
|
||||
#else
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
|
@ -132,13 +131,7 @@ add v (Just (o, e)) = case j of
|
|||
j = case v of
|
||||
AesonObject ao -> Object ao
|
||||
JSONChunk l -> object $ map mkPair l
|
||||
mkPair (s, d) =
|
||||
(
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
AK.fromText $
|
||||
#endif
|
||||
packString s
|
||||
, toJSON' d)
|
||||
mkPair (s, d) = (textKey (packString s), toJSON' d)
|
||||
add _ Nothing = Nothing
|
||||
|
||||
complete :: JSONChunk v -> JSONBuilder
|
||||
|
@ -184,13 +177,7 @@ data ObjectMap a = ObjectMap { fromObjectMap :: M.Map String a }
|
|||
instance ToJSON' a => ToJSON' (ObjectMap a) where
|
||||
toJSON' (ObjectMap m) = object $ map go $ M.toList m
|
||||
where
|
||||
go (k, v) =
|
||||
(
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
AK.fromText $
|
||||
#endif
|
||||
packString k
|
||||
, toJSON' v)
|
||||
go (k, v) = (textKey (packString k), toJSON' v)
|
||||
|
||||
-- An item that a git-annex command acts on, and displays a JSON object about.
|
||||
data JSONActionItem a = JSONActionItem
|
||||
|
|
12
Remote.hs
12
Remote.hs
|
@ -5,7 +5,7 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings, CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Remote (
|
||||
Remote,
|
||||
|
@ -63,9 +63,6 @@ module Remote (
|
|||
|
||||
import Data.Ord
|
||||
import Data.String
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
import qualified Data.Aeson.Key as AK
|
||||
#endif
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Vector as V
|
||||
|
||||
|
@ -247,12 +244,7 @@ prettyPrintUUIDsWith optfield header descm showval uuidvals = do
|
|||
, Just ("here", toJSON' $ hereu == u)
|
||||
, case (optfield, optval) of
|
||||
(Just field, Just val) -> Just
|
||||
(
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
AK.fromText $
|
||||
#endif
|
||||
packString field
|
||||
, toJSON' val)
|
||||
(textKey (packString field), toJSON' val)
|
||||
_ -> Nothing
|
||||
]
|
||||
|
||||
|
|
|
@ -7,7 +7,6 @@
|
|||
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Types.MetaData (
|
||||
MetaData(..),
|
||||
|
@ -52,9 +51,6 @@ import Utility.QuickCheck
|
|||
import Utility.Aeson
|
||||
import Types.UUID
|
||||
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
import qualified Data.Aeson.Key as AK
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Set as S
|
||||
|
@ -71,13 +67,7 @@ newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue))
|
|||
instance ToJSON' MetaData where
|
||||
toJSON' (MetaData m) = object $ map go (M.toList m)
|
||||
where
|
||||
go (MetaField f, s) =
|
||||
(
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
AK.fromText $
|
||||
#endif
|
||||
CI.original f
|
||||
, toJSON' s)
|
||||
go (MetaField f, s) = (textKey (CI.original f), toJSON' s)
|
||||
|
||||
instance FromJSON MetaData where
|
||||
parseJSON (Object o) = do
|
||||
|
|
|
@ -15,11 +15,15 @@ module Utility.Aeson (
|
|||
encode,
|
||||
packString,
|
||||
packByteString,
|
||||
textKey,
|
||||
) where
|
||||
|
||||
import Data.Aeson as X hiding (ToJSON, toJSON, encode, Key)
|
||||
import Data.Aeson hiding (encode)
|
||||
import qualified Data.Aeson
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
import qualified Data.Aeson.Key as AK
|
||||
#endif
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
|
@ -68,6 +72,14 @@ packString s = case T.decodeUtf8' (encodeBS s) of
|
|||
Right t -> t
|
||||
Left _ -> T.pack s
|
||||
|
||||
#if MIN_VERSION_aeson(2,0,0)
|
||||
textKey :: T.Text -> AK.Key
|
||||
textKey = AK.fromText
|
||||
#else
|
||||
textKey :: T.Text -> T.Text
|
||||
textKey = id
|
||||
#endif
|
||||
|
||||
-- | The same as packString . decodeBS, but more efficient in the usual
|
||||
-- case.
|
||||
packByteString :: S.ByteString -> T.Text
|
||||
|
|
Loading…
Reference in a new issue