{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskellQuotes #-}

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

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

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 Data.Text.Short as ST
import qualified Language.Haskell.TH.Syntax as TH
import qualified Test.QuickCheck as QC

newtype Key = Key { Key -> Text
unKey :: Text }
  deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq, Eq Key
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
$cp1Ord :: Eq Key
Ord, Typeable, Typeable Key
DataType
Constr
Typeable Key
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Key -> c Key)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Key)
-> (Key -> Constr)
-> (Key -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Key))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key))
-> ((forall b. Data b => b -> b) -> Key -> Key)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r)
-> (forall u. (forall d. Data d => d -> u) -> Key -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Key -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Key -> m Key)
-> Data Key
Key -> DataType
Key -> Constr
(forall b. Data b => b -> b) -> Key -> Key
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
forall u. (forall d. Data d => d -> u) -> Key -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cKey :: Constr
$tKey :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapMp :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapM :: (forall d. Data d => d -> m d) -> Key -> m Key
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Key -> m Key
gmapQi :: Int -> (forall d. Data d => d -> u) -> Key -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Key -> u
gmapQ :: (forall d. Data d => d -> u) -> Key -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Key -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Key -> r
gmapT :: (forall b. Data b => b -> b) -> Key -> Key
$cgmapT :: (forall b. Data b => b -> b) -> Key -> Key
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Key)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Key)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Key)
dataTypeOf :: Key -> DataType
$cdataTypeOf :: Key -> DataType
toConstr :: Key -> Constr
$ctoConstr :: Key -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Key
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Key -> c Key
$cp1Data :: Typeable Key
Data)

fromString :: String -> Key
fromString :: String -> Key
fromString = Text -> Key
Key (Text -> Key) -> (String -> Text) -> String -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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

fromText :: Text -> Key
fromText :: Text -> Key
fromText = Text -> Key
Key

toText :: Key -> Text
toText :: Key -> Text
toText = Key -> Text
unKey

-- | @'coercing r1 r2'@ will evaluate to @r1@ if 'Key' is 'Coercible' to  'Text',
-- and to @r2@ otherwise.
--
-- Using 'coercing' we can make more efficient implementations
-- when 'Key' is backed up by 'Text' without exposing internals.
-- 
coercionToText :: Maybe (Coercion Key Text)
coercionToText :: Maybe (Coercion Key Text)
coercionToText = Coercion Key Text -> Maybe (Coercion Key Text)
forall a. a -> Maybe a
Just Coercion Key Text
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
{-# INLINE coercionToText #-}

-- | @since 2.0.2.0
toShortText :: Key -> ST.ShortText
toShortText :: Key -> ShortText
toShortText = Text -> ShortText
ST.fromText (Text -> ShortText) -> (Key -> Text) -> Key -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
unKey

-- | @since 2.0.2.0
fromShortText :: ST.ShortText -> Key
fromShortText :: ShortText -> Key
fromShortText = Text -> Key
Key (Text -> Key) -> (ShortText -> Text) -> ShortText -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ST.toText

-------------------------------------------------------------------------------
-- instances
-------------------------------------------------------------------------------

instance Read Key where
    readPrec :: ReadPrec Key
readPrec = String -> Key
fromString (String -> Key) -> ReadPrec String -> ReadPrec Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec String
forall a. Read a => ReadPrec a
readPrec

instance Show Key where
    showsPrec :: Int -> Key -> ShowS
showsPrec Int
d (Key Text
k) = Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
d Text
k 

instance Data.String.IsString Key where
    fromString :: String -> Key
fromString = String -> Key
fromString

instance Hashable Key where
    hashWithSalt :: Int -> Key -> Int
hashWithSalt Int
salt (Key Text
k) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Text
k

instance NFData Key where
    rnf :: Key -> ()
rnf (Key Text
k) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
k

instance Semigroup Key where
    Key Text
x <> :: Key -> Key -> Key
<> Key Text
y = Text -> Key
Key (Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
y)

instance Monoid Key where
    mempty :: Key
mempty = Text -> Key
Key Text
forall a. Monoid a => a
mempty
    mappend :: Key -> Key -> Key
mappend = Key -> Key -> Key
forall a. Semigroup a => a -> a -> a
(<>)

instance TH.Lift Key where
#if MIN_VERSION_text(1,2,4)
    lift :: Key -> Q Exp
lift (Key Text
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 :: Key -> Q (TExp Key)
liftTyped = Q Exp -> Q (TExp Key)
forall a. Q Exp -> Q (TExp a)
TH.unsafeTExpCoerce (Q Exp -> Q (TExp Key)) -> (Key -> Q Exp) -> Key -> Q (TExp Key)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift
#endif

-- | @since 2.0.3.0
instance QC.Arbitrary Key where
    arbitrary :: Gen Key
arbitrary = String -> Key
fromString (String -> Key) -> Gen String -> Gen Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
QC.arbitrary
    shrink :: Key -> [Key]
shrink Key
k  = String -> Key
fromString (String -> Key) -> [String] -> [Key]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
forall a. Arbitrary a => a -> [a]
QC.shrink (Key -> String
toString Key
k)

-- | @since 2.0.3.0
instance QC.CoArbitrary Key where
    coarbitrary :: Key -> Gen b -> Gen b
coarbitrary = String -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (String -> Gen b -> Gen b)
-> (Key -> String) -> Key -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> String
toString

-- | @since 2.0.3.0
instance QC.Function Key where
    function :: (Key -> b) -> Key :-> b
function = (Key -> String) -> (String -> Key) -> (Key -> b) -> Key :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap Key -> String
toString String -> Key
fromString