{-# LANGUAGE CPP                        #-}

module Data.KeyStore.Types.AesonCompat
  ( module A
  , module Data.KeyStore.Types.AesonCompat
  ) where

import qualified Data.HashMap.Strict            as HM
import qualified Data.Text                      as T


#if MIN_VERSION_aeson(2,0,0)


import           Data.Aeson                     as A  hiding (Key)
import qualified Data.Aeson.Key                 as A
import qualified Data.Aeson.KeyMap              as A

type KM a = A.KeyMap a

fromKM :: KM a -> HM.HashMap T.Text a
fromKM :: KM a -> HashMap Text a
fromKM = (Key -> Text) -> HashMap Key a -> HashMap Text a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys Key -> Text
A.toText (HashMap Key a -> HashMap Text a)
-> (KM a -> HashMap Key a) -> KM a -> HashMap Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KM a -> HashMap Key a
forall v. KeyMap v -> HashMap Key v
A.toHashMap

intoKM :: HM.HashMap T.Text a -> KM a
intoKM :: HashMap Text a -> KM a
intoKM = HashMap Key a -> KM a
forall v. HashMap Key v -> KeyMap v
A.fromHashMap (HashMap Key a -> KM a)
-> (HashMap Text a -> HashMap Key a) -> HashMap Text a -> KM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Key) -> HashMap Text a -> HashMap Key a
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
HM.mapKeys Text -> Key
A.fromText


#else


import           Data.Aeson                     as A

type KM a = HM.HashMap T.Text a

fromKM :: KM a -> HM.HashMap T.Text a
fromKM = id

intoKM :: HM.HashMap T.Text a -> KM a
intoKM = id


#endif