Add support for Aeson 2 (jaspervdj#900)

Zekt · Oct 24, 2021 · b8df202 · b8df202
1 parent 20619a8
commit b8df202
Show file tree

Hide file tree

Showing 3 changed files with 52 additions and 20 deletions.
diff --git a/hakyll.cabal b/hakyll.cabal
@@ -174,7 +174,7 @@ Library
     Paths_hakyll
 
   Build-Depends:
-    aeson                >= 1.0      && < 1.6,
+    aeson                >= 1.0      && < 1.6 || >= 2.0 && < 2.1,
     base                 >= 4.8      && < 5,
     binary               >= 0.5      && < 0.10,
     blaze-html           >= 0.5      && < 0.10,
@@ -281,6 +281,7 @@ Test-suite hakyll-tests
     tasty-hunit                >= 0.9  && < 0.11,
     tasty-quickcheck           >= 0.8  && < 0.11,
     -- Copy pasted from hakyll dependencies:
+    aeson                >= 1.0      && < 1.6 || >= 2.0 && < 2.1,
     base                 >= 4.8      && < 5,
     bytestring           >= 0.9      && < 0.12,
     containers           >= 0.3      && < 0.7,

diff --git a/lib/Hakyll/Core/Metadata.hs b/lib/Hakyll/Core/Metadata.hs
@@ -1,4 +1,5 @@
 --------------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
 module Hakyll.Core.Metadata
     ( Metadata
     , lookupString
@@ -14,12 +15,16 @@ module Hakyll.Core.Metadata
 
 
 --------------------------------------------------------------------------------
-import           Control.Arrow                  (second)
 import           Control.Monad                  (forM)
 import           Control.Monad.Fail             (MonadFail)
 import           Data.Binary                    (Binary (..), getWord8,
                                                  putWord8, Get)
-import qualified Data.HashMap.Strict            as HMS
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.KeyMap              as KeyMap
+import qualified Data.Aeson.Key                 as AK
+#else
+import qualified Data.HashMap.Strict            as KeyMap
+#endif
 import qualified Data.Set                       as S
 import qualified Data.Text                      as T
 import qualified Data.Vector                    as V
@@ -35,13 +40,13 @@ type Metadata = Yaml.Object
 
 --------------------------------------------------------------------------------
 lookupString :: String -> Metadata -> Maybe String
-lookupString key meta = HMS.lookup (T.pack key) meta >>= Yaml.toString
+lookupString key meta = KeyMap.lookup (keyFromString key) meta >>= Yaml.toString
 
 
 --------------------------------------------------------------------------------
 lookupStringList :: String -> Metadata -> Maybe [String]
 lookupStringList key meta =
-    HMS.lookup (T.pack key) meta >>= Yaml.toList >>= mapM Yaml.toString
+    KeyMap.lookup (keyFromString key) meta >>= Yaml.toList >>= mapM Yaml.toString
 
 
 --------------------------------------------------------------------------------
@@ -106,7 +111,7 @@ instance Binary BinaryYaml where
         Yaml.Object obj -> do
             putWord8 0
             let list :: [(T.Text, BinaryYaml)]
-                list = map (second BinaryYaml) $ HMS.toList obj
+                list = map (\(k, v) -> (keyToText k, BinaryYaml v)) $ KeyMap.toList obj
             put list
 
         Yaml.Array arr -> do
@@ -125,7 +130,7 @@ instance Binary BinaryYaml where
             0 -> do
                 list <- get :: Get [(T.Text, BinaryYaml)]
                 return $ BinaryYaml $ Yaml.Object $
-                    HMS.fromList $ map (second unBinaryYaml) list
+                    KeyMap.fromList $ map (\(k, v) -> (keyFromText k, unBinaryYaml v)) list
 
             1 -> do
                 list <- get :: Get [BinaryYaml]
@@ -137,3 +142,25 @@ instance Binary BinaryYaml where
             4 -> BinaryYaml . Yaml.Bool   <$> get
             5 -> return $ BinaryYaml Yaml.Null
             _ -> fail "Data.Binary.get: Invalid Binary Metadata"
+
+
+--------------------------------------------------------------------------------
+#if MIN_VERSION_aeson(2,0,0)
+keyFromString :: String -> AK.Key
+keyFromString = AK.fromString
+
+keyToText :: AK.Key -> T.Text
+keyToText = AK.toText
+
+keyFromText :: T.Text -> AK.Key
+keyFromText = AK.fromText
+#else
+keyFromString :: String -> T.Text
+keyFromString = T.pack
+
+keyToText :: T.Text -> T.Text
+keyToText = id
+
+keyFromText :: T.Text -> T.Text
+keyFromText = id
+#endif
diff --git a/tests/Hakyll/Core/Provider/Metadata/Tests.hs b/tests/Hakyll/Core/Provider/Metadata/Tests.hs
@@ -1,12 +1,18 @@
 --------------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
 module Hakyll.Core.Provider.Metadata.Tests
     ( tests
     ) where
 
 
 --------------------------------------------------------------------------------
-import qualified Data.HashMap.Strict           as HMS
+#if MIN_VERSION_aeson(2,0,0)
+import qualified Data.Aeson.KeyMap             as KeyMap
+import qualified Data.Aeson.Key                as AK
+#else
+import qualified Data.HashMap.Strict           as KeyMap
 import qualified Data.Text                     as T
+#endif
 import qualified Data.Yaml                     as Yaml
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Metadata
@@ -26,32 +32,30 @@ tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $
 testPage01 :: Assertion
 testPage01 =
     (meta [("foo", "bar")], "qux\n") `expectRight` parsePage
-    "---\n\
-    \foo: bar\n\
-    \---\n\
-    \qux\n"
+    "---\nfoo: bar\n---\nqux\n"
 
 
 --------------------------------------------------------------------------------
 testPage02 :: Assertion
 testPage02 =
     (meta [("description", descr)], "Hello I am dog\n") `expectRight`
     parsePage
-    "---\n\
-    \description: A long description that would look better if it\n\
-    \             spanned multiple lines and was indented\n\
-    \---\n\
-    \Hello I am dog\n"
+    "---\ndescription: A long description that would look better if it\n             spanned multiple lines and was indented\n---\nHello I am dog\n"
   where
     descr :: String
     descr =
-        "A long description that would look better if it \
-        \spanned multiple lines and was indented"
+        "A long description that would look better if it spanned multiple lines and was indented"
 
 
 --------------------------------------------------------------------------------
 meta :: Yaml.ToJSON a => [(String, a)] -> Metadata
-meta pairs = HMS.fromList [(T.pack k, Yaml.toJSON v) | (k, v) <- pairs]
+meta pairs = KeyMap.fromList [(keyFromString k, Yaml.toJSON v) | (k, v) <- pairs]
+  where
+#if MIN_VERSION_aeson(2,0,0)
+  keyFromString = AK.fromString
+#else
+  keyFromString = T.pack
+#endif
 
 
 --------------------------------------------------------------------------------