{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Aeson.Extra.TH (
mkValue,
mkValue',
) where
import Data.Aeson.Compat
import Language.Haskell.TH
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
#if !MIN_VERSION_aeson_compat(0,3,5)
import Data.Aeson.Types (Parser)
#endif
#if !MIN_VERSION_aeson(0,11,0)
import Data.Bifunctor (first)
import Data.Scientific (base10Exponent, coefficient, scientific)
import Language.Haskell.TH.Syntax (Lift (..))
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
#endif
mkValue :: String -> Q Exp
mkValue :: String -> Q Exp
mkValue s :: String
s = case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' ByteString
bs :: Either String Value of
Left err :: 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
$ "mkValue: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
Right v :: 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
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 '\'' = '"'
f x :: Char
x = Char
x
#if !MIN_VERSION_aeson(0,11,0)
instance Lift Value where
lift Null = [| Null |]
lift (Bool b) = [| Bool b |]
lift (Number n) = [| Number (scientific c e) |]
where
c = coefficient n
e = base10Exponent n
lift (String t) = [| String (T.pack s) |]
where s = T.unpack t
lift (Array a) = [| Array (V.fromList a') |]
where a' = V.toList a
lift (Object o) = [| Object (HM.fromList . map (first T.pack) $ o') |]
where o' = map (first T.unpack) . HM.toList $ o
#endif