Skip to content

Commit

Permalink
Provide Key as a type synonym, not abstract
Browse files Browse the repository at this point in the history
  • Loading branch information
tomjaguarpaw committed Feb 27, 2022
1 parent 1493c76 commit 44d8ec2
Show file tree
Hide file tree
Showing 4 changed files with 11 additions and 63 deletions.
57 changes: 11 additions & 46 deletions src/Data/Aeson/Key.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE PatternSynonyms #-}

module Data.Aeson.Key (
Key,
Expand All @@ -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
Expand Down Expand Up @@ -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
7 changes: 0 additions & 7 deletions src/Data/Aeson/Types/FromJSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
7 changes: 0 additions & 7 deletions src/Data/Aeson/Types/ToJSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 0 additions & 3 deletions tests/Instances.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit 44d8ec2

Please sign in to comment.