{-# LANGUAGE CPP #-}

module HaskellWorks.Data.Aeson.Compat
  ( Key
  , textToKey
  , keyToText
  , stringToKey
  , keyToString
  ) where

import Data.Text (Text)
import Data.Text.Short (ShortText)

import qualified Data.Text as T
import qualified Data.Text.Short as ST

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key    as J
#endif

#if MIN_VERSION_aeson(2,0,0)
type Key = J.Key
#else
type Key = Text
#endif

textToKey :: Text -> Key
#if MIN_VERSION_aeson(2,0,0)
textToKey :: Text -> Key
textToKey = Text -> Key
J.fromText
#else
textToKey = id
#endif

keyToText :: Key -> Text
#if MIN_VERSION_aeson(2,0,0)
keyToText :: Key -> Text
keyToText = Key -> Text
J.toText
#else
keyToText = id
#endif

stringToKey :: String -> Key
#if MIN_VERSION_aeson(2,0,0)
stringToKey :: String -> Key
stringToKey = String -> Key
J.fromString
#else
stringToKey = T.pack
#endif

keyToString :: Key -> String
#if MIN_VERSION_aeson(2,0,0)
keyToString :: Key -> String
keyToString = Key -> String
J.toString
#else
keyToString = T.unpack
#endif


shortTextToKey :: ShortText -> Key
#if MIN_VERSION_aeson(2,0,0)
shortTextToKey :: ShortText -> Key
shortTextToKey = ShortText -> Key
J.fromShortText
#else
shortTextToKey = ST.toText
#endif

keyToShortText :: Key -> ShortText
#if MIN_VERSION_aeson(2,0,0)
keyToShortText :: Key -> ShortText
keyToShortText = Key -> ShortText
J.toShortText
#else
keyToShortText = ST.fromText
#endif