aeson-2.* compat

CHANGELOG.md

@@ -1,3 +1,6 @@
+## Changes in 0.34.5
+  - Compatibility with `aeson-2.*`
+
 ## Changes in 0.34.4
   - Render `default-extensions` / `other-extensions` line-separated
   - Compatibility with `Cabal-3.4.0.0`

hpack.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           hpack
-version:        0.34.4
+version:        0.34.5
 synopsis:       A modern format for Haskell packages
 description:    See README at <https://github.com/sol/hpack#readme>
 category:       Development
@@ -56,6 +56,8 @@ library
       Hpack.Yaml
   other-modules:
       Data.Aeson.Config.FromValue
+      Data.Aeson.Config.Key
+      Data.Aeson.Config.KeyMap
       Data.Aeson.Config.Parser
       Data.Aeson.Config.Types
       Data.Aeson.Config.Util
@@ -177,6 +179,8 @@ test-suite spec
       Hpack.UtilSpec
       HpackSpec
       Data.Aeson.Config.FromValue
+      Data.Aeson.Config.Key
+      Data.Aeson.Config.KeyMap
       Data.Aeson.Config.Parser
       Data.Aeson.Config.Types
       Data.Aeson.Config.Util

package.yaml

@@ -1,5 +1,5 @@
 name: hpack
-version: 0.34.4
+version: 0.34.5
 synopsis: A modern format for Haskell packages
 description: See README at <https://github.com/sol/hpack#readme>
 maintainer: Simon Hengel <[email protected]>

src/Data/Aeson/Config/FromValue.hs

@@ -34,6 +34,7 @@ module Data.Aeson.Config.FromValue (
 , (.:)
 , (.:?)
 
+, Key
 , Value(..)
 , Object
 , Array
@@ -45,9 +46,11 @@ import           GHC.Generics
 
 import           Data.Map.Lazy (Map)
 import qualified Data.Map.Lazy as Map
-import qualified Data.Text as T
 import qualified Data.Vector as V
-import qualified Data.HashMap.Strict as HashMap
+import           Data.Aeson.Config.Key (Key)
+import qualified Data.Aeson.Config.Key as Key
+import qualified Data.Aeson.Config.KeyMap as KeyMap
+
 import           Data.Aeson.Types (FromJSON(..))
 
 import           Data.Aeson.Config.Util
@@ -58,10 +61,10 @@ type Result a = Either String (a, [String])
 decodeValue :: FromValue a => Value -> Result a
 decodeValue = runParser fromValue
 
-(.:) :: FromValue a => Object -> Text -> Parser a
+(.:) :: FromValue a => Object -> Key -> Parser a
 (.:) = explicitParseField fromValue
 
-(.:?) :: FromValue a => Object -> Text -> Parser (Maybe a)
+(.:?) :: FromValue a => Object -> Key -> Parser (Maybe a)
 (.:?) = explicitParseFieldMaybe fromValue
 
 class FromValue a where
@@ -102,11 +105,11 @@ parseArray f = zipWithM (parseIndexed f) [0..] . V.toList
 instance FromValue a => FromValue (Map String a) where
   fromValue = withObject $ \ o -> do
     xs <- traverseObject fromValue o
-    return $ Map.fromList (map (first T.unpack) xs)
+    return $ Map.fromList (map (first Key.toString) xs)
 
-traverseObject :: (Value -> Parser a) -> Object -> Parser [(Text, a)]
+traverseObject :: (Value -> Parser a) -> Object -> Parser [(Key, a)]
 traverseObject f o = do
-  forM (HashMap.toList o) $ \ (name, value) ->
+  forM (KeyMap.toList o) $ \ (name, value) ->
     (,) name <$> f value <?> Key name
 
 instance (FromValue a, FromValue b) => FromValue (a, b) where
@@ -140,7 +143,7 @@ instance (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 a)) where
 instance {-# OVERLAPPING #-} (Selector sel, FromValue a) => GenericDecode (S1 sel (Rec0 (Maybe a))) where
   genericDecode = accessFieldWith (.:?)
 
-accessFieldWith :: forall sel a p. Selector sel => (Object -> Text -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p)
-accessFieldWith op Options{..} v = M1 . K1 <$> withObject (`op` T.pack label) v
+accessFieldWith :: forall sel a p. Selector sel => (Object -> Key -> Parser a) -> Options -> Value -> Parser (S1 sel (Rec0 a) p)
+accessFieldWith op Options{..} v = M1 . K1 <$> withObject (`op` Key.fromString label) v
   where
     label = optionsRecordSelectorModifier $ selName (undefined :: S1 sel (Rec0 a) p)

src/Data/Aeson/Config/Key.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE CPP #-}
+module Data.Aeson.Config.Key (module Data.Aeson.Config.Key) where
+
+#if MIN_VERSION_aeson(2,0,0)
+
+import           Data.Aeson.Key as Data.Aeson.Config.Key
+
+#else
+
+import           Data.Text (Text)
+import qualified Data.Text as T
+
+type Key = Text
+
+toText :: Key -> Text
+toText = id
+
+toString :: Key -> String
+toString = T.unpack
+
+fromString :: String -> Key
+fromString = T.pack
+
+#endif

src/Data/Aeson/Config/KeyMap.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE CPP #-}
+module Data.Aeson.Config.KeyMap (module KeyMap) where
+
+#if MIN_VERSION_aeson(2,0,0)
+import           Data.Aeson.KeyMap as KeyMap
+#else
+import           Data.HashMap.Strict as KeyMap
+#endif

src/Data/Aeson/Config/Parser.hs

@@ -40,7 +40,9 @@ import           Data.Set (Set, notMember)
 import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Vector as V
-import qualified Data.HashMap.Strict as HashMap
+import           Data.Aeson.Config.Key (Key)
+import qualified Data.Aeson.Config.Key as Key
+import qualified Data.Aeson.Config.KeyMap as KeyMap
 import           Data.Aeson.Types (Value(..), Object, Array)
 import qualified Data.Aeson.Types as Aeson
 import           Data.Aeson.Internal (IResult(..), iparse)
@@ -59,7 +61,7 @@ fromAesonPath = reverse . map fromAesonPathElement
 
 fromAesonPathElement :: Aeson.JSONPathElement -> JSONPathElement
 fromAesonPathElement e = case e of
-  Aeson.Key k -> Key k
+  Aeson.Key k -> Key (Key.toText k)
   Aeson.Index n -> Index n
 
 newtype Parser a = Parser {unParser :: WriterT (Set JSONPath) Aeson.Parser a}
@@ -94,7 +96,7 @@ determineUnconsumed ((<> Set.singleton []) -> consumed) = Set.toList . execWrite
           Bool _ -> return ()
           Null -> return ()
           Object o -> do
-            forM_ (HashMap.toList o) $ \ (k, v) -> do
+            forM_ (KeyMap.toList o) $ \ (Key.toText -> k, v) -> do
               unless ("_" `T.isPrefixOf` k) $ do
                 go (Key k : path) v
           Array xs -> do
@@ -113,13 +115,13 @@ markConsumed e = do
 getPath :: Parser JSONPath
 getPath = liftParser $ Aeson.parserCatchError empty $ \ path _ -> return (fromAesonPath path)
 
-explicitParseField :: (Value -> Parser a) -> Object -> Text -> Parser a
-explicitParseField p o key = case HashMap.lookup key o of
+explicitParseField :: (Value -> Parser a) -> Object -> Key -> Parser a
+explicitParseField p o key = case KeyMap.lookup key o of
   Nothing -> fail $ "key " ++ show key ++ " not present"
   Just v  -> p v <?> Aeson.Key key
 
-explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Text -> Parser (Maybe a)
-explicitParseFieldMaybe p o key = case HashMap.lookup key o of
+explicitParseFieldMaybe :: (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
+explicitParseFieldMaybe p o key = case KeyMap.lookup key o of
   Nothing -> pure Nothing
   Just v  -> Just <$> p v <?> Aeson.Key key
 

src/Hpack/Config.hs

@@ -86,7 +86,7 @@ import           Data.Either
 import           Data.Bitraversable
 import           Data.Map.Lazy (Map)
 import qualified Data.Map.Lazy as Map
-import qualified Data.HashMap.Lazy as HashMap
+import qualified Data.Aeson.Config.KeyMap as KeyMap
 import           Data.Maybe
 import           Data.Ord
 import qualified Data.Text as T
@@ -428,10 +428,10 @@ instance FromValue a => FromValue (ParseConditionalSection a) where
     | otherwise = FlatConditional <$> fromValue v
     where
       giveHint = case v of
-        Object o -> case (,,) <$> HashMap.lookup "then" o <*> HashMap.lookup "else" o <*> HashMap.lookup "condition" o of
+        Object o -> case (,,) <$> KeyMap.lookup "then" o <*> KeyMap.lookup "else" o <*> KeyMap.lookup "condition" o of
           Just (Object then_, Object else_, String condition) -> do
-            when (HashMap.null then_) $ "then" `emptyTryInstead` flatElse
-            when (HashMap.null else_) $ "else" `emptyTryInstead` flatThen
+            when (KeyMap.null then_) $ "then" `emptyTryInstead` flatElse
+            when (KeyMap.null else_) $ "else" `emptyTryInstead` flatThen
             where
               flatThen = flatConditional condition then_
               flatElse = flatConditional (negate_ condition) else_
@@ -440,7 +440,7 @@ instance FromValue a => FromValue (ParseConditionalSection a) where
 
       negate_ condition = "!(" <> condition <> ")"
 
-      flatConditional condition sect = object [("when" .= HashMap.insert "condition" (String condition) sect)]
+      flatConditional condition sect = object [("when" .= KeyMap.insert "condition" (String condition) sect)]
 
       emptyTryInstead :: String -> Value -> Parser ()
       emptyTryInstead name sect = do
@@ -457,8 +457,8 @@ instance FromValue a => FromValue (ParseConditionalSection a) where
                 (_, "condition") -> GT
                 _ -> compare a b
 
-hasKey :: Text -> Value -> Bool
-hasKey key (Object o) = HashMap.member key o
+hasKey :: Key -> Value -> Bool
+hasKey key (Object o) = KeyMap.member key o
 hasKey _ _ = False
 
 newtype Condition = Condition {

src/Hpack/Syntax/Defaults.hs

@@ -15,7 +15,7 @@ module Hpack.Syntax.Defaults (
 
 import           Imports
 
-import           Data.HashMap.Lazy (member)
+import           Data.Aeson.Config.KeyMap (member)
 import qualified Data.Text as T
 import           System.FilePath.Posix (splitDirectories)
 

src/Hpack/Syntax/DependencyVersion.hs

@@ -31,7 +31,7 @@ import qualified Control.Monad.Fail as Fail
 import           Data.Maybe
 import           Data.Scientific
 import qualified Data.Text as T
-import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Aeson.Config.KeyMap as KeyMap
 import           Text.PrettyPrint (renderStyle, Style(..), Mode(..))
 
 import qualified Distribution.Version as D
@@ -113,7 +113,7 @@ objectDependency o = let
 
     source :: Parser (Maybe SourceDependency)
     source
-      | any (`HashMap.member` o) ["path", "git", "github", "ref", "subdir"] = Just <$> (local <|> git)
+      | any (`KeyMap.member` o) ["path", "git", "github", "ref", "subdir"] = Just <$> (local <|> git)
       | otherwise = return Nothing
 
     in DependencyVersion <$> source <*> version

src/Hpack/Syntax/ParseDependencies.hs

@@ -5,6 +5,7 @@ module Hpack.Syntax.ParseDependencies where
 import           Imports
 
 import           Data.Aeson.Config.FromValue
+import qualified Data.Aeson.Config.Key as Key
 
 data Parse k v = Parse {
   parseString  :: Text -> Parser (k, v)
@@ -17,7 +18,7 @@ parseDependencies :: Parse k v -> Value -> Parser [(k, v)]
 parseDependencies parse@Parse{..} v = case v of
   String s -> return <$> parseString s
   Array xs -> parseArray (buildToolFromValue parse) xs
-  Object o -> map (first parseName) <$> traverseObject parseDictItem o
+  Object o -> map (first (parseName . Key.toText)) <$> traverseObject parseDictItem o
   _ -> typeMismatch "Array, Object, or String" v
 
 buildToolFromValue :: Parse k v -> Value -> Parser (k, v)