module QuickPlot.IPC.QQ (
json
) where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote
import qualified Data.Vector as V
import qualified Data.Text as T
import Data.Aeson hiding (json)
import QuickPlot.IPC.QQParser
json :: QuasiQuoter
json = QuasiQuoter { quoteExp = jsonExp
, quotePat = const $ error "No quotePat defined for jsonQQ"
, quoteType = const $ error "No quoteType defined for jsonQQ"
, quoteDec = const $ error "No quoteDec defined for jsonQQ"
}
jsonExp :: String -> ExpQ
jsonExp string =
case parseTHJSON string of
Left err -> error $ "JSON is invalid: " ++ show err
Right val -> [| val |]
instance Lift Value where
lift value = [| value |]
instance Lift JSONValue where
lift (JSONString string) = [| String (T.pack string) |]
lift JSONNull = [| Null |]
lift (JSONObject objects) = [| object $jsonList |]
where
jsonList :: ExpQ
jsonList = ListE <$> mapM objs2list objects
objs2list :: (HashKey, JSONValue) -> ExpQ
objs2list (key, value) = case key of
HashStringKey k -> [|(T.pack k, $(lift value))|]
HashVarKey k -> [|(T.pack $(dyn k), $(lift value))|]
lift (JSONArray arr) = [| Array $ V.fromList $(ListE <$> mapM lift arr) |]
lift (JSONNumber n) = [| Number (fromRational $(return $ LitE $ RationalL (toRational n))) |]
lift (JSONBool b) = [| Bool b |]
lift (JSONCode e) = [| toJSON $(return e) |]