@@ -1,45 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−-- | Like "Data.Aeson.QQ" but without interpolation.
3−module Data.Aeson.QQ.Simple where
4−
5−import Data.Aeson
6−import Data.ByteString.Lazy.UTF8 as UTF8
7−import qualified Data.HashMap.Strict as HM
8−import qualified Data.Text as T
9−import qualified Data.Vector as V
10−import Language.Haskell.TH
11−import Language.Haskell.TH.Quote
12−import Language.Haskell.TH.Syntax (Lift (..))
13−import Prelude ()
14−import Prelude.Compat
15−
16−aesonQQ :: QuasiQuoter
17−aesonQQ = QuasiQuoter
18− { quoteExp = aesonExp
19− , quotePat = const $ error "No quotePat defined for jsonQQ"
20− , quoteType = const $ error "No quoteType defined for jsonQQ"
21− , quoteDec = const $ error "No quoteDec defined for jsonQQ"
22− }
23−
24−aesonExp :: String -> ExpQ
25−aesonExp txt =
26− case eitherDecode $ UTF8.fromString txt of
27− Left err -> error $ "Error in aesonExp: " ++ show err
28− Right val -> liftValue val
29−
30−liftValue :: Value -> ExpQ
31−liftValue (String str) = [| String $(liftText str) |]
32−liftValue Null = [| Null |]
33−liftValue (Number n) = [| Number (fromRational $(return $ LitE $ RationalL (toRational n))) |]
34−liftValue (Bool b) = [| Bool b |]
35−liftValue (Array arr) = [| Array $ V.fromList $(ListE <$> traverse liftValue (V.toList arr)) |]
36−liftValue (Object obj) = [| object $jsList |]
37− where
38− jsList :: ExpQ
39− jsList = ListE <$> traverse objs2list (HM.toList obj)
40−
41− objs2list :: (T.Text, Value) -> ExpQ
42− objs2list (key, value) = [| ($(liftText key), $(liftValue value)) |]
43−
44−liftText :: T.Text -> ExpQ
45−liftText t = [| T.pack $(lift $ T.unpack t) |]