-- | 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 (..))

-- | 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 :: [Char] -> Q Exp
quoteExp  = [Char] -> Q Exp
aesonExp
    , quotePat :: [Char] -> Q Pat
quotePat  = Q Pat -> [Char] -> Q Pat
forall a b. a -> b -> a
const (Q Pat -> [Char] -> Q Pat) -> Q Pat -> [Char] -> Q Pat
forall a b. (a -> b) -> a -> b
$ [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"No quotePat defined for jsonQQ"
    , quoteType :: [Char] -> Q Type
quoteType = Q Type -> [Char] -> Q Type
forall a b. a -> b -> a
const (Q Type -> [Char] -> Q Type) -> Q Type -> [Char] -> Q Type
forall a b. (a -> b) -> a -> b
$ [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"No quoteType defined for jsonQQ"
    , quoteDec :: [Char] -> Q [Dec]
quoteDec  = Q [Dec] -> [Char] -> Q [Dec]
forall a b. a -> b -> a
const (Q [Dec] -> [Char] -> Q [Dec]) -> Q [Dec] -> [Char] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"No quoteDec defined for jsonQQ"
    }

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