{-# LANGUAGE CPP #-}
module Log.Internal.Aeson.Compat
  ( module Map
#if !MIN_VERSION_aeson(2,0,1)
  , KeyMap
#endif
  , fromText
  , doName
  ) where

import Data.Text

#if MIN_VERSION_aeson(2,0,1)
import Data.Aeson.KeyMap as Map 
import qualified Data.Aeson.Key as K

fromText :: Text -> K.Key
fromText :: Text -> Key
fromText = Text -> Key
K.fromText

doName :: Monad m => (Text -> m Text) -> K.Key -> m K.Key
doName :: forall (m :: * -> *). Monad m => (Text -> m Text) -> Key -> m Key
doName Text -> m Text
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
K.fromText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Text
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
K.toText

#else

import Data.HashMap.Strict as Map

type KeyMap a = Map.HashMap Text a

fromText :: Text -> Text
fromText = id

doName :: (Text -> m Text) -> Text -> m Text
doName = id

#endif