Skip to content

Commit 8504271

Browse files
andreasabelandreasabel
committed
Migrate to aeson-2.0
HashMap -> KeyMap, Text -> Key
1 parent 5e5eaaa commit 8504271

File tree

9 files changed

+81
-70
lines changed

9 files changed

+81
-70
lines changed

‎hackage-server.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ common defaults
112112
, scientific
113113
-- other dependencies shared by most components
114114
build-depends:
115-
, aeson ^>= 1.5
115+
, aeson ^>= 2.0.3.0
116116
, Cabal ^>= 3.4.1.0
117117
, fail ^>= 4.9.0
118118
-- we use Control.Monad.Except, introduced in mtl-2.2.1
@@ -361,7 +361,7 @@ library lib-server
361361
, acid-state ^>= 0.16
362362
, async ^>= 2.2.1
363363
-- requires bumping http-io-streams
364-
, attoparsec ^>= 0.13
364+
, attoparsec ^>= 0.14.4
365365
, base16-bytestring ^>= 1.0
366366
-- requires bumping http-io-streams
367367
, base64-bytestring ^>= 1.1

‎src/Distribution/Server/Features/Core.hs‎

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -23,9 +23,10 @@ module Distribution.Server.Features.Core (
2323
-- stdlib
2424
import qualified Codec.Compression.GZip as GZip
2525
import Data.Aeson (Value (..))
26+
import qualified Data.Aeson.Key as Key
27+
import qualified Data.Aeson.KeyMap as KeyMap
2628
import Data.ByteString.Lazy (ByteString)
2729
import qualified Data.Foldable as Foldable
28-
import qualified Data.HashMap.Strict as HashMap
2930
import qualified Data.Text as Text
3031
import Data.Time.Clock (UTCTime, getCurrentTime)
3132
import Data.Time.Format (defaultTimeLocale, formatTime)
@@ -688,8 +689,8 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
688689
-- in particular, we use objects for the packages so that we can add
689690
-- additional fields later without (hopefully) breaking clients
690691
let json = flip map list $ \str ->
691-
Object . HashMap.fromList $ [
692-
(Text.pack "packageName", String (Text.pack str))
692+
Object . KeyMap.fromList $ [
693+
(Key.fromString "packageName", String (Text.pack str))
693694
]
694695
return . toResponse $ Array (Vec.fromList json)
695696

@@ -727,10 +728,10 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
727728
let revisions = pkgMetadataRevisions pkginfo
728729
revisionToObj rev (_, (utime, uid)) =
729730
let uname = userIdToName users uid in
730-
Object $ HashMap.fromList
731-
[ (Text.pack "number", Number (fromIntegral rev))
732-
, (Text.pack "user", String (Text.pack (display uname)))
733-
, (Text.pack "time", String (Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" utime)))
731+
Object $ KeyMap.fromList
732+
[ (Key.fromString "number", Number (fromIntegral rev))
733+
, (Key.fromString "user", String (Text.pack (display uname)))
734+
, (Key.fromString "time", String (Text.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" utime)))
734735
]
735736
revisionsJson = Array $ Vec.imap revisionToObj revisions
736737
return (toResponse revisionsJson)

‎src/Distribution/Server/Features/PackageCandidates.hs‎

Lines changed: 19 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -43,15 +43,15 @@ import Distribution.Version
4343
import qualified Data.Text as T
4444
import qualified Data.Text.Encoding as T
4545
import qualified Data.Text.Encoding.Error as T
46-
import qualified Data.ByteString.Lazy as BS (ByteString, toStrict)
47-
import qualified Text.XHtml.Strict as XHtml
48-
import Text.XHtml.Strict ((<<), (!))
49-
import Data.Aeson (Value (..), object, toJSON, (.=))
50-
51-
import Data.Function (fix)
52-
import Data.List (find, intersperse)
53-
import Data.Time.Clock (getCurrentTime)
54-
import qualified Data.Vector as Vec
46+
import qualified Data.ByteString.Lazy as BS (ByteString, toStrict)
47+
import qualified Text.XHtml.Strict as XHtml
48+
import Text.XHtml.Strict ((<<), (!))
49+
import Data.Aeson (Value (..), object, toJSON, (.=))
50+
import qualified Data.Aeson.Key as Key
51+
import Data.Function (fix)
52+
import Data.List (find, intersperse)
53+
import Data.Time.Clock (getCurrentTime)
54+
import qualified Data.Vector as Vec
5555

5656

5757
data PackageCandidatesFeature = PackageCandidatesFeature {
@@ -281,10 +281,10 @@ candidatesFeature ServerEnv{serverBlobStore = store}
281281
users <- queryGetUserDb
282282
let lupUserName uid = (uid, fmap Users.userName (Users.lookupUserId uid users))
283283

284-
let pvs = [ object [ T.pack "version" .= (T.pack . display . packageVersion . candInfoId) p
285-
, T.pack "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
286-
, T.pack "time" .= (fst . snd) tarball
287-
, T.pack "uploader" .= (lupUserName . snd . snd) tarball
284+
let pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p
285+
, Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
286+
, Key.fromString "time" .= (fst . snd) tarball
287+
, Key.fromString "uploader" .= (lupUserName . snd . snd) tarball
288288
]
289289
| p <- pkgs
290290
, let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p
@@ -304,11 +304,14 @@ candidatesFeature ServerEnv{serverBlobStore = store}
304304
where
305305
cpiToJSON :: [CandPkgInfo] -> Value
306306
cpiToJSON [] = Null -- should never happen
307-
cpiToJSON pkgs = object [ T.pack "name" .= pn, T.pack "candidates" .= pvs ]
307+
cpiToJSON pkgs = object
308+
[ Key.fromString "name" .= pn
309+
, Key.fromString "candidates" .= pvs
310+
]
308311
where
309312
pn = T.pack . display . pkgName . candInfoId . head $ pkgs
310-
pvs = [ object [ T.pack "version" .= (T.pack . display . packageVersion . candInfoId) p
311-
, T.pack "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
313+
pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p
314+
, Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
312315
]
313316
| p <- pkgs
314317
, let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p

‎src/Distribution/Server/Features/PackageInfoJSON/State.hs‎

Lines changed: 20 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -15,8 +15,9 @@ import Control.Monad.Reader (ask, asks)
1515
import qualified Control.Monad.State as State
1616
import qualified Data.Aeson as Aeson
1717
import Data.Aeson ((.=), (.:))
18+
import qualified Data.Aeson.Key as Key
19+
import qualified Data.Aeson.KeyMap as KeyMap
1820
import Data.Acid (Query, Update, makeAcidic)
19-
import qualified Data.HashMap.Strict as HashMap
2021
import qualified Data.Map.Strict as Map
2122
import Data.Monoid (Sum(..))
2223
import qualified Data.Text as T
@@ -85,30 +86,30 @@ instance SafeCopy PackageBasicDescription where
8586
instance Aeson.ToJSON PackageBasicDescription where
8687
toJSON PackageBasicDescription {..} =
8788
Aeson.object
88-
[ T.pack "license" .= Pretty.prettyShow pbd_license
89-
, T.pack "copyright" .= pbd_copyright
90-
, T.pack "synopsis" .= pbd_synopsis
91-
, T.pack "description" .= pbd_description
92-
, T.pack "author" .= pbd_author
93-
, T.pack "homepage" .= pbd_homepage
94-
, T.pack "metadata_revision" .= pbd_metadata_revision
89+
[ Key.fromString "license" .= Pretty.prettyShow pbd_license
90+
, Key.fromString "copyright" .= pbd_copyright
91+
, Key.fromString "synopsis" .= pbd_synopsis
92+
, Key.fromString "description" .= pbd_description
93+
, Key.fromString "author" .= pbd_author
94+
, Key.fromString "homepage" .= pbd_homepage
95+
, Key.fromString "metadata_revision" .= pbd_metadata_revision
9596
]
9697

9798

9899
instance Aeson.FromJSON PackageBasicDescription where
99100
parseJSON = Aeson.withObject "PackageBasicDescription" $ \obj -> do
100-
pbd_version' <- obj .: T.pack "license"
101+
pbd_version' <- obj .: Key.fromString "license"
101102
let parseEitherLicense t =
102103
Parsec.simpleParsec t <|> fmap licenseToSPDX (simpleParse t)
103104
case parseEitherLicense pbd_version' of
104105
Nothing -> fail $ concat ["Could not parse version: \"", pbd_version', "\""]
105106
Just pbd_license -> do
106-
pbd_copyright <- obj .: T.pack "copyright"
107-
pbd_synopsis <- obj .: T.pack "synopsis"
108-
pbd_description <- obj .: T.pack "description"
109-
pbd_author <- obj .: T.pack "author"
110-
pbd_homepage <- obj .: T.pack "homepage"
111-
pbd_metadata_revision <- obj .: T.pack "metadata_revision"
107+
pbd_copyright <- obj .: Key.fromString "copyright"
108+
pbd_synopsis <- obj .: Key.fromString "synopsis"
109+
pbd_description <- obj .: Key.fromString "description"
110+
pbd_author <- obj .: Key.fromString "author"
111+
pbd_homepage <- obj .: Key.fromString "homepage"
112+
pbd_metadata_revision <- obj .: Key.fromString "metadata_revision"
112113
return $
113114
PackageBasicDescription {..}
114115

@@ -161,14 +162,13 @@ instance Aeson.FromJSON PackageVersions where
161162
parseJSON = Aeson.withObject "PackageVersions" $ \obj ->
162163
fmap PackageVersions
163164
$ traverse (parsePair)
164-
$ HashMap.toList obj
165+
$ KeyMap.toList obj
165166
where
166167
parsePair (vStr, vStatus) =
167-
(,) <$> parseVersion vStr <*> parseStatus vStatus
168+
(,) <$> parseVersion (Key.toString vStr) <*> parseStatus vStatus
168169

169-
parseVersion verText =
170-
let verString = T.unpack verText
171-
in case simpleParse verString of
170+
parseVersion verString =
171+
case simpleParse verString of
172172
Just ver -> return ver
173173
Nothing -> fail $ concat ["Could not parse \""
174174
, verString ++ "\" as Version. "

‎src/Distribution/Server/Features/PreferredVersions.hs‎

Lines changed: 16 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -28,18 +28,19 @@ import Distribution.Package
2828
import Distribution.Version
2929
import Distribution.Text
3030

31-
import Data.Function (fix)
32-
import Data.List (intercalate, find)
33-
import Data.Maybe (isJust, fromMaybe, catMaybes)
34-
import Data.Time.Clock (getCurrentTime)
35-
import Control.Arrow (second)
36-
import Control.Applicative (optional)
37-
import qualified Data.Map as Map
31+
import Control.Arrow (first, second)
32+
import Control.Applicative (optional)
33+
import Data.Aeson (Value(..))
34+
import Data.Function (fix)
35+
import Data.List (intercalate, find)
36+
import Data.Maybe (isJust, fromMaybe, catMaybes)
37+
import Data.Time.Clock (getCurrentTime)
38+
import qualified Data.Aeson.Key as Key
39+
import qualified Data.Aeson.KeyMap as KeyMap
3840
import qualified Data.ByteString.Lazy.Char8 as BS (pack) -- Only used for ASCII data
39-
import Data.Aeson (Value(..))
40-
import qualified Data.HashMap.Strict as HashMap
41-
import qualified Data.Text as Text
42-
import qualified Data.Vector as Vector
41+
import qualified Data.Map as Map
42+
import qualified Data.Text as Text
43+
import qualified Data.Vector as Vector
4344

4445
data VersionsFeature = VersionsFeature {
4546
versionsFeatureInterface :: HackageFeature,
@@ -198,7 +199,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
198199
versionType DeprecatedVersion = "deprecated-version"
199200
versionType UnpreferredVersion = "unpreferred-version"
200201
return . toResponse . object
201-
$ map (\(i, vs) -> (Text.pack . versionType $ i, array $ map (string . display) vs))
202+
$ map (\(i, vs) -> (versionType $ i, array $ map (string . display) vs))
202203
$ Map.toList classifiedVersions
203204

204205
handlePackagesDeprecatedGet :: DynamicPath -> ServerPartE Response
@@ -234,7 +235,7 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
234235
Object o
235236
-- FIXME should just be a nested case
236237
-- or something more human friendly
237-
| fields <- HashMap.toList o
238+
| fields <- KeyMap.toList o
238239
, Just (Bool deprecated) <- lookup "is-deprecated" fields
239240
, Just (Array strs) <- lookup "in-favour-of" fields
240241
-- FIXME Audit this parsing -> PackageName code, suspiciously
@@ -415,8 +416,8 @@ versionsFeature ServerEnv{ serverVerbosity = verbosity }
415416
array :: [Value] -> Value
416417
array = Array . Vector.fromList
417418

418-
object :: [(Text.Text, Value)] -> Value
419-
object = Object . HashMap.fromList
419+
object :: [(String, Value)] -> Value
420+
object = Object . KeyMap.fromList . map (first Key.fromString)
420421

421422
string :: String -> Value
422423
string = String . Text.pack

‎src/Distribution/Server/Features/Search.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import qualified Data.Map as Map
3232

3333
import Control.Applicative (optional)
3434
import Data.Aeson
35+
import qualified Data.Aeson.Key as Key
3536

3637
data SearchFeature = SearchFeature {
3738
searchFeatureInterface :: HackageFeature,
@@ -185,7 +186,7 @@ searchFeature ServerEnv{serverBaseURI} CoreFeature{..} ListFeature{getAllLists}
185186
_ ->
186187
errBadRequest "Invalid search request" [MText $ "Empty terms query"]
187188
where packageNameJSON pkgName =
188-
object [ T.pack "name" .= unPackageName pkgName ]
189+
object [ Key.fromString "name" .= unPackageName pkgName ]
189190

190191
{-
191192
suggestJson :: ServerPartE Response

‎src/Distribution/Server/Features/ServerIntrospect.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,8 @@ import Text.XHtml.Strict
1414
, anchor, (!), href, name
1515
, ordList, unordList )
1616
import Data.Aeson (Value(..))
17-
import qualified Data.HashMap.Strict as HashMap
17+
import qualified Data.Aeson.Key as Key
18+
import qualified Data.Aeson.KeyMap as KeyMap
1819
import qualified Data.Vector as Vector
1920
import qualified Data.Text as Text
2021
import Data.List
@@ -338,7 +339,7 @@ array :: [Value] -> Value
338339
array = Array . Vector.fromList
339340

340341
object :: [(String, Value)] -> Value
341-
object = Object . HashMap.fromList . map (first Text.pack)
342+
object = Object . KeyMap.fromList . map (first Key.fromString)
342343

343344
string :: String -> Value
344345
string = String . Text.pack

‎src/Distribution/Server/Features/Votes.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -21,9 +21,10 @@ import Distribution.Package
2121
import Distribution.Text
2222

2323
import Data.Aeson
24+
import qualified Data.Aeson.Key as Key
25+
import qualified Data.Aeson.KeyMap as KeyMap
2426
import qualified Data.Map as Map
2527
import qualified Data.Text as T
26-
import qualified Data.HashMap.Strict as HashMap
2728

2829
import Control.Arrow (first)
2930
import qualified Text.XHtml.Strict as X
@@ -212,7 +213,7 @@ votesFeature ServerEnv{..}
212213

213214
-- Use to construct a list of tuples that can be toJSON'd
214215
objectL :: [(String, Value)] -> Value
215-
objectL = Object . HashMap.fromList . map (first T.pack)
216+
objectL = Object . KeyMap.fromList . map (first Key.fromString)
216217

217218
-- Use inside an objectL to transform strings into json values
218219
string :: String -> Value

‎src/Distribution/Server/Framework/HtmlFormWrapper.hs‎

Lines changed: 8 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,8 @@ import qualified Data.ByteString.Lazy as BS
1313
import qualified Data.ByteString.Lazy.Char8 as BS8
1414
import qualified Data.Aeson as JSON
1515
import qualified Data.Text as T
16-
import qualified Data.HashMap.Strict as HMap
16+
import qualified Data.Aeson.Key as Key
17+
import qualified Data.Aeson.KeyMap as KeyMap
1718
import Control.Concurrent.MVar
1819

1920
import Distribution.Server.Framework.HappstackUtils (showContentType)
@@ -187,18 +188,20 @@ accumJPaths js = f JSON.Null
187188
f = foldr (\ j r -> insertJPath j >=> r) Just js
188189

189190
insertJPath :: JPath -> JSON.Value -> Maybe JSON.Value
191+
190192
insertJPath (JField f p) JSON.Null = do
191193
v <- insertJPath p JSON.Null
192-
return (JSON.object [(f, v)])
194+
return (JSON.object [(Key.fromText f, v)])
193195

194196
insertJPath (JField f p) (JSON.Object obj) = do
195-
case HMap.lookup f obj of
197+
let k = Key.fromText f
198+
case KeyMap.lookup k obj of
196199
Nothing -> do
197200
v <- insertJPath p JSON.Null
198-
return (JSON.Object (HMap.insert f v obj))
201+
return (JSON.Object (KeyMap.insert k v obj))
199202
Just v0 -> do
200203
v <- insertJPath p v0
201-
return (JSON.Object (HMap.insert f v obj))
204+
return (JSON.Object (KeyMap.insert k v obj))
202205

203206
insertJPath (JVal v) JSON.Null = return v
204207
insertJPath _ _ = Nothing

0 commit comments

Comments
 (0)