{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Aeson.Extra.TH
-- Copyright   :  (C) 2015-2016 Oleg Grenrus
-- License     :  BSD3
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
-- In addition to 'mkValue' and 'mkValue'' helpers,
-- this module exports 'Lift' 'Value' orphan instance for aeson <0.11
module Data.Aeson.Extra.TH (
    mkValue,
    mkValue',
    ) where

import Language.Haskell.TH

import qualified Data.Text          as T
import qualified Data.Text.Encoding as TE

import Data.Aeson

-- | Create a 'Value' from string representation.
--
-- This is useful in tests.
--
-- /Since: aeson-extra-0.3.1.0/
mkValue :: String -> Q Exp
mkValue :: String -> Q Exp
mkValue String
s = case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
bs :: Either String Value of
    Left String
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"mkValue: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
    Right Value
v  -> [| v |]
  where bs :: ByteString
bs = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s

-- | Like 'mkValue', but replace single quotes with double quotes before.
--
-- > > $(mkValue' "{'a': 2 }")
-- > Object (fromList [("a",Number 2.0)])
--
-- /Since: aeson-extra-0.3.1.0/
mkValue' :: String -> Q Exp
mkValue' :: String -> Q Exp
mkValue' = String -> Q Exp
mkValue (String -> Q Exp) -> (String -> String) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f
  where f :: Char -> Char
f Char
'\'' = Char
'"'
        f Char
x    = Char
x