From 44d8ec2099b44e04f92217623f6c95117542f668 Mon Sep 17 00:00:00 2001
From: Tom Ellis <tom-git@jaguarpaw.co.uk>
Date: Sun, 27 Feb 2022 19:50:27 +0000
Subject: [PATCH] Provide Key as a type synonym, not abstract

---
 src/Data/Aeson/Key.hs            | 57 ++++++--------------------------
 src/Data/Aeson/Types/FromJSON.hs |  7 ----
 src/Data/Aeson/Types/ToJSON.hs   |  7 ----
 tests/Instances.hs               |  3 --
 4 files changed, 11 insertions(+), 63 deletions(-)

diff --git a/src/Data/Aeson/Key.hs b/src/Data/Aeson/Key.hs
index 431093340..3a43fbcaf 100644
--- a/src/Data/Aeson/Key.hs
+++ b/src/Data/Aeson/Key.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module Data.Aeson.Key (
     Key,
@@ -12,25 +13,22 @@ module Data.Aeson.Key (
     coercionToText,
 ) where
 
-import Prelude (Eq, Ord, (.), Show (..), String, Maybe (..))
+import Prelude ((.), String, Maybe (..), id)
 
-import Control.Applicative ((<$>))
-import Control.DeepSeq (NFData(..))
-import Data.Data (Data)
-import Data.Hashable (Hashable(..))
-import Data.Monoid (Monoid(mempty, mappend))
-import Data.Semigroup (Semigroup((<>)))
 import Data.Text (Text)
 import Data.Type.Coercion (Coercion (..))
-import Data.Typeable (Typeable)
-import Text.Read (Read (..))
 
-import qualified Data.String
 import qualified Data.Text as T
 import qualified Language.Haskell.TH.Syntax as TH
 
-newtype Key = Key { unKey :: Text }
-  deriving (Eq, Ord, Typeable, Data)
+type Key = Text
+
+unKey :: Key -> Text
+unKey = id
+
+pattern Key :: p -> p
+pattern Key a <- a
+  where Key a = a
 
 fromString :: String -> Key
 fromString = Key . T.pack
@@ -58,37 +56,4 @@ coercionToText = Just Coercion
 -- instances
 -------------------------------------------------------------------------------
 
-instance Read Key where
-    readPrec = fromString <$> readPrec
-
-instance Show Key where
-    showsPrec d (Key k) = showsPrec d k 
-
-instance Data.String.IsString Key where
-    fromString = fromString
-
-instance Hashable Key where
-    hashWithSalt salt (Key k) = hashWithSalt salt k
-
-instance NFData Key where
-    rnf (Key k) = rnf k
-
-instance Semigroup Key where
-    Key x <> Key y = Key (x <> y)
-
-instance Monoid Key where
-    mempty = Key mempty
-    mappend = (<>)
-
-instance TH.Lift Key where
-#if MIN_VERSION_text(1,2,4)
-    lift (Key k) = [| Key k |]
-#else
-    lift k = [| fromString k' |] where k' = toString k
-#endif
-
-#if MIN_VERSION_template_haskell(2,17,0)
-    liftTyped = TH.unsafeCodeCoerce . TH.lift
-#elif MIN_VERSION_template_haskell(2,16,0)
-    liftTyped = TH.unsafeTExpCoerce . TH.lift
-#endif
+-- No instances for type synonym
diff --git a/src/Data/Aeson/Types/FromJSON.hs b/src/Data/Aeson/Types/FromJSON.hs
index 2ea6dd44b..00cab1051 100644
--- a/src/Data/Aeson/Types/FromJSON.hs
+++ b/src/Data/Aeson/Types/FromJSON.hs
@@ -1966,13 +1966,6 @@ instance (FromJSON v, FromJSONKey k, Eq k, Hashable k) => FromJSON (H.HashMap k
 -- aeson
 -------------------------------------------------------------------------------
 
-instance FromJSON Key where
-    parseJSON = withText "Key" (pure . Key.fromText)
-
-instance FromJSONKey Key where
-    -- TODO: make me more efficient.
-    fromJSONKey = FromJSONKeyText Key.fromText
-
 instance FromJSON Value where
     parseJSON = pure
 
diff --git a/src/Data/Aeson/Types/ToJSON.hs b/src/Data/Aeson/Types/ToJSON.hs
index 5933a6144..9507b5bc4 100644
--- a/src/Data/Aeson/Types/ToJSON.hs
+++ b/src/Data/Aeson/Types/ToJSON.hs
@@ -1763,13 +1763,6 @@ instance (ToJSON v, ToJSONKey k) => ToJSON (H.HashMap k v) where
 -- aeson
 -------------------------------------------------------------------------------
 
-instance ToJSON Key where
-    toJSON = toJSON . Key.toText
-    toEncoding = E.key
-
-instance ToJSONKey Key where
-    toJSONKey = ToJSONKeyText id E.key
-
 instance ToJSON Value where
     toJSON a = a
     toEncoding = E.value
diff --git a/tests/Instances.hs b/tests/Instances.hs
index f4045f0cb..68730dc9a 100644
--- a/tests/Instances.hs
+++ b/tests/Instances.hs
@@ -169,9 +169,6 @@ instance (ApproxEq a) => ApproxEq [a] where
 instance Arbitrary a => Arbitrary (DList.DList a) where
     arbitrary = DList.fromList <$> arbitrary
 
-instance Arbitrary Key where
-    arbitrary = Key.fromText <$> arbitrary
-
 instance Arbitrary Value where
     arbitrary = sized arb where
         arb :: Int -> Gen Value