Skip to content

Data.Aeson.Key #868

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Sep 15, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions aeson.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -68,6 +68,7 @@ library
Data.Aeson.Internal
Data.Aeson.Internal.Time
Data.Aeson.Parser.Internal
Data.Aeson.Key
Data.Aeson.KeyMap

-- Deprecated modules
Expand Down
1 change: 1 addition & 0 deletions benchmarks/aeson-benchmarks.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,7 @@ library
Data.Aeson.Internal
Data.Aeson.Internal.Functions
Data.Aeson.Internal.Time
Data.Aeson.Key
Data.Aeson.KeyMap
Data.Aeson.Parser
Data.Aeson.Parser.Internal
Expand Down
1 change: 1 addition & 0 deletions src/Data/Aeson.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,7 @@ module Data.Aeson
, fromEncoding
, Array
, Object
, Key
-- * Convenience types
, DotNetTime(..)
-- * Type conversion
Expand Down
9 changes: 7 additions & 2 deletions src/Data/Aeson/Encoding/Builder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,8 @@ module Data.Aeson.Encoding.Builder
import Prelude.Compat

import Data.Aeson.Internal.Time
import Data.Aeson.Types.Internal (Value (..))
import Data.Aeson.Types.Internal (Value (..), Key)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KM
import Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim as BP
Expand Down Expand Up @@ -96,7 +97,11 @@ object m = case KM.toList m of
_ -> emptyObject_
where
withComma a z = B.char8 ',' <> one a <> z
one (k,v) = text k <> B.char8 ':' <> encodeToBuilder v
one (k,v) = key k <> B.char8 ':' <> encodeToBuilder v

-- | Encode a JSON key.
key :: Key -> Builder
key = text . Key.toText

-- | Encode a JSON string.
text :: T.Text -> Builder
Expand Down
15 changes: 10 additions & 5 deletions src/Data/Aeson/Encoding/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ module Data.Aeson.Encoding.Internal
, wrapArray
, null_
, bool
, key
, text
, lazyText
, string
Expand Down Expand Up @@ -61,8 +62,9 @@ module Data.Aeson.Encoding.Internal

import Prelude.Compat

import Data.Aeson.Types.Internal (Value)
import Data.Aeson.Types.Internal (Value, Key)
import Data.ByteString.Builder (Builder, char7, toLazyByteString)
import qualified Data.Aeson.Key as Key
import Data.Int
import Data.Scientific (Scientific)
import Data.Text (Text)
Expand Down Expand Up @@ -127,15 +129,15 @@ data Series = Empty
| Value (Encoding' Series)
deriving (Typeable)

pair :: Text -> Encoding -> Series
pair name val = pair' (text name) val
pair :: Key -> Encoding -> Series
pair name val = pair' (key name) val
{-# INLINE pair #-}

pairStr :: String -> Encoding -> Series
pairStr name val = pair' (string name) val
{-# INLINE pairStr #-}

pair' :: Encoding' Text -> Encoding -> Series
pair' :: Encoding' Key -> Encoding -> Series
pair' name val = Value $ retagEncoding $ retagEncoding name >< colon >< val

instance Semigroup Series where
Expand Down Expand Up @@ -184,7 +186,7 @@ list to' (x:xs) = openBracket >< to' x >< commas xs >< closeBracket

-- | Encode as JSON object
dict
:: (k -> Encoding' Text) -- ^ key encoding
:: (k -> Encoding' Key) -- ^ key encoding
-> (v -> Encoding) -- ^ value encoding
-> (forall a. (k -> v -> a -> a) -> a -> m -> a) -- ^ @foldrWithKey@ - indexed fold
-> m -- ^ container
Expand Down Expand Up @@ -226,6 +228,9 @@ tuple :: Encoding' InArray -> Encoding
tuple b = retagEncoding $ openBracket >< b >< closeBracket
{-# INLINE tuple #-}

key :: Key -> Encoding' a
key = text . Key.toText

text :: Text -> Encoding' a
text = Encoding . EB.text

Expand Down
4 changes: 2 additions & 2 deletions src/Data/Aeson/Internal/Functions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,13 +17,13 @@ module Data.Aeson.Internal.Functions
import Prelude.Compat

import Data.Hashable (Hashable)
import Data.Aeson.Key (Key)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.HashMap.Strict as H
import qualified Data.Map as M
import qualified Data.Text as T

-- | Transform a 'M.Map' into a 'KM.KeyMap' while transforming the keys.
mapTextKeyVal :: (k -> T.Text) -> (v1 -> v2)
mapTextKeyVal :: (k -> Key) -> (v1 -> v2)
-> M.Map k v1 -> KM.KeyMap v2
mapTextKeyVal fk kv = M.foldrWithKey (\k v -> KM.insert (fk k) (kv v)) KM.empty
{-# INLINE mapTextKeyVal #-}
Expand Down
89 changes: 89 additions & 0 deletions src/Data/Aeson/Key.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,89 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}

#if __GLASGOW_HASKELL__ >= 800
-- a) THQ works on cross-compilers and unregisterised GHCs
-- b) may make compilation faster as no dynamic loading is ever needed (not sure about this)
-- c) removes one hindrance to have code inferred as SafeHaskell safe
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
{-# LANGUAGE TemplateHaskell #-}
#endif

module Data.Aeson.Key (
Key,
fromString,
toString,
toText,
fromText,
) where

import Prelude (Eq, Ord, (.), Show (..), String)

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.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)

fromString :: String -> Key
fromString = Key . T.pack

toString :: Key -> String
toString (Key k) = T.unpack k

fromText :: Text -> Key
fromText = Key

toText :: Key -> Text
toText = unKey

-------------------------------------------------------------------------------
-- 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
Loading