{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}

{- |
Module      :  GitHub.REST.KeyValue
Maintainer  :  Brandon Chinn <brandon@leapyear.io>
Stability   :  experimental
Portability :  portable

Define the 'KeyValue' helper type.
-}
module GitHub.REST.KeyValue (
  KeyValue (..),
  kvToValue,
  kvToText,
) where

import Data.Aeson (ToJSON (..), Value (..), object)
import Data.Aeson.Types (Pair)
import Data.Scientific (floatingOrInteger)
import Data.Text (Text)
import qualified Data.Text as Text

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.Key (fromText)
#endif

-- | A type representing a key-value pair.
data KeyValue where
  (:=) :: (Show v, ToJSON v) => Text -> v -> KeyValue

infixr 1 :=

instance Show KeyValue where
  show :: KeyValue -> String
show = (Text, Text) -> String
forall a. Show a => a -> String
show ((Text, Text) -> String)
-> (KeyValue -> (Text, Text)) -> KeyValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyValue -> (Text, Text)
kvToText

instance {-# OVERLAPS #-} ToJSON [KeyValue] where
  toJSON :: [KeyValue] -> Value
toJSON = [KeyValue] -> Value
kvToValue

-- | Convert a 'KeyValue' into a 'Pair'.
toPair :: KeyValue -> Pair
toPair :: KeyValue -> Pair
toPair (Text
k := v
v) = (Text -> Key
fromText Text
k, v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v)

-- | Convert the given KeyValues into a JSON Object.
kvToValue :: [KeyValue] -> Value
kvToValue :: [KeyValue] -> Value
kvToValue = [Pair] -> Value
object ([Pair] -> Value) -> ([KeyValue] -> [Pair]) -> [KeyValue] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyValue -> Pair) -> [KeyValue] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map KeyValue -> Pair
toPair

-- | Represent the given KeyValue as a pair of Texts.
kvToText :: KeyValue -> (Text, Text)
kvToText :: KeyValue -> (Text, Text)
kvToText (Text
k := v
v) = (Text
k, Text
v')
  where
    v' :: Text
v' = case v -> Value
forall a. ToJSON a => a -> Value
toJSON v
v of
      String Text
t -> Text
t
      Number Scientific
x -> String -> Text
Text.pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
prettyNum (Scientific -> Text) -> Scientific -> Text
forall a b. (a -> b) -> a -> b
$ Scientific
x
      Bool Bool
b -> String -> Text
Text.pack (String -> Text) -> (Bool -> String) -> Bool -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show (Bool -> Text) -> Bool -> Text
forall a b. (a -> b) -> a -> b
$ Bool
b
      Value
_ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Could not convert value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
v
    prettyNum :: Scientific -> String
prettyNum Scientific
x = (Double -> String)
-> (Integer -> String) -> Either Double Integer -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Double -> String
forall a. Show a => a -> String
show Integer -> String
forall a. Show a => a -> String
show (Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
x :: Either Double Integer)

{- Helpers -}

#if !MIN_VERSION_aeson(2,0,0)
fromText :: Text -> Text
fromText = id
#endif