    {-# LANGUAGE TemplateHaskell #-}
    -- | Have a look at the <https://github.com/sol/aeson-qq#readme README> for
    -- documentation.
    module Data.Aeson.QQ (aesonQQ) where

    import Prelude ()
    import Prelude.Compat

    import Language.Haskell.TH
    import Language.Haskell.TH.Quote

    import qualified Data.Vector as V
    import qualified Data.Text as T
    import Data.Aeson

    import Data.JSON.QQ as QQ

    aesonQQ :: QuasiQuoter
    aesonQQ :: QuasiQuoter
    aesonQQ = QuasiQuoter :: (String -> Q Exp)
    -> (String -> Q Pat)
    -> (String -> Q Type)
    -> (String -> Q [Dec])
    -> QuasiQuoter
    QuasiQuoter {
      quoteExp :: String -> Q Exp
    quoteExp = String -> Q Exp
    jsonExp,
      quotePat :: String -> Q Pat
    quotePat = Q Pat -> String -> Q Pat
    forall a b. a -> b -> a
    const (Q Pat -> String -> Q Pat) -> Q Pat -> String -> Q Pat
    forall a b. (a -> b) -> a -> b
    $ String -> Q Pat
    forall a. HasCallStack => String -> a
    error "No quotePat defined for jsonQQ",
      quoteType :: String -> Q Type
    quoteType = Q Type -> String -> Q Type
    forall a b. a -> b -> a
    const (Q Type -> String -> Q Type) -> Q Type -> String -> Q Type
    forall a b. (a -> b) -> a -> b
    $ String -> Q Type
    forall a. HasCallStack => String -> a
    error "No quoteType defined for jsonQQ",
      quoteDec :: String -> Q [Dec]
    quoteDec = Q [Dec] -> String -> Q [Dec]
    forall a b. a -> b -> a
    const (Q [Dec] -> String -> Q [Dec]) -> Q [Dec] -> String -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ String -> Q [Dec]
    forall a. HasCallStack => String -> a
    error "No quoteDec defined for jsonQQ"
    }

    jsonExp :: String -> ExpQ
    jsonExp :: String -> Q Exp
    jsonExp txt :: String
    txt =
      case Either ParseError JsonValue
    parsed' of
        Left err :: ParseError
    err -> String -> Q Exp
    forall a. HasCallStack => String -> a
    error (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ "Error in aesonExp: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    err
        Right val :: JsonValue
    val -> JsonValue -> Q Exp
    toExp JsonValue
    val
      where
        parsed' :: Either ParseError JsonValue
    parsed' = String -> Either ParseError JsonValue
    QQ.parsedJson String
    txt

    ----
    -- JSValue etc to ExpQ
    ---------
    toExp :: QQ.JsonValue -> ExpQ
    toExp :: JsonValue -> Q Exp
    toExp (JsonString str :: String
    str) = [|String (T.pack str)|]
    toExp (JsonValue
    JsonNull) = [|Null|]
    toExp (JsonObject objs :: [(HashKey, JsonValue)]
    objs) = [|object $jsList|]
        where
          jsList :: ExpQ
          jsList :: Q Exp
    jsList = [Exp] -> Exp
    ListE ([Exp] -> Exp) -> Q [Exp] -> Q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((HashKey, JsonValue) -> Q Exp)
    -> [(HashKey, JsonValue)] -> Q [Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (HashKey, JsonValue) -> Q Exp
    objs2list ([(HashKey, JsonValue)]
    objs)

          objs2list :: (HashKey, JsonValue) -> ExpQ
          objs2list :: (HashKey, JsonValue) -> Q Exp
    objs2list (key :: HashKey
    key, value :: JsonValue
    value) = do
            case HashKey
    key of
              HashStringKey k :: String
    k -> [|(T.pack k, $(toExp value))|]
              HashVarKey k :: String
    k -> [|(T.pack $(dyn k), $(toExp value))|]
    toExp (JsonArray arr :: [JsonValue]
    arr) = [|Array $ V.fromList $(ListE <$> mapM toExp arr)|]
    toExp (JsonNumber n :: Scientific
    n) = [|Number (fromRational $(return $ LitE $ RationalL (toRational n)))|]
    toExp (JsonBool b :: Bool
    b) = [|Bool b|]
    toExp (JsonCode e :: Exp
    e) = [|toJSON $(return e)|]