-- | Like @<https://hackage.haskell.org/package/aeson-qq/docs/Data-Aeson-QQ.html Data.Aeson.QQ>@ but without interpolation.
module Data.Aeson.QQ.Simple (aesonQQ) where

import           Data.Aeson
import qualified Data.Text                  as T
import qualified Data.Text.Encoding         as TE
import           Language.Haskell.TH
import           Language.Haskell.TH.Quote
import           Language.Haskell.TH.Syntax (Lift (..))
import           Prelude                    ()
import           Prelude.Compat


-- | Converts a string representation of a JSON value into 'Data.Aeson.Value' at compile-time.
--
-- @
-- {-\# LANGUAGE QuasiQuotes \#-}
--
-- import Data.Aeson (Value)
-- import Data.Aeson.QQ.Simple
--
-- joe :: 'Value'
-- joe = [aesonQQ|{ "name": \"Joe\", "age": 12 }|]
-- @
aesonQQ :: QuasiQuoter
aesonQQ :: QuasiQuoter
aesonQQ = QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp  = String -> Q Exp
aesonExp
    , quotePat :: String -> Q Pat
quotePat  = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"No quotePat defined for jsonQQ"
    , quoteType :: String -> Q Type
quoteType = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"No quoteType defined for jsonQQ"
    , quoteDec :: String -> Q [Dec]
quoteDec  = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"No quoteDec defined for jsonQQ"
    }

aesonExp :: String -> ExpQ
aesonExp :: String -> Q Exp
aesonExp String
txt =
  case forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
txt of
    Left String
err  -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error in aesonExp: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
err
    Right Value
val -> forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift (Value
val :: Value)