{-# LANGUAGE ViewPatterns #-}

module HsInspect.Json where

import qualified Data.Text as T
import qualified GHC as GHC
import HsInspect.Sexp
import Json
import MonadUtils (mapSndM)
import Outputable (showSDoc)
import Util (mapFst)

encodeJson :: GHC.DynFlags -> JsonDoc -> String
encodeJson :: DynFlags -> JsonDoc -> String
encodeJson DynFlags
dflags JsonDoc
j = DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (SDoc -> String) -> (JsonDoc -> SDoc) -> JsonDoc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonDoc -> SDoc
renderJSON (JsonDoc -> String) -> JsonDoc -> String
forall a b. (a -> b) -> a -> b
$ JsonDoc
j

sexpToJson :: Sexp -> Either String JsonDoc
sexpToJson :: Sexp -> Either String JsonDoc
sexpToJson Sexp
SexpNil = JsonDoc -> Either String JsonDoc
forall a b. b -> Either a b
Right JsonDoc
JSNull
sexpToJson (Sexp -> Maybe [(Text, Sexp)]
toAList -> Just [(Text, Sexp)]
kvs) = [(String, JsonDoc)] -> JsonDoc
JSObject ([(String, JsonDoc)] -> JsonDoc)
-> ([(Text, JsonDoc)] -> [(String, JsonDoc)])
-> [(Text, JsonDoc)]
-> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [(Text, JsonDoc)] -> [(String, JsonDoc)]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFst Text -> String
T.unpack ([(Text, JsonDoc)] -> JsonDoc)
-> Either String [(Text, JsonDoc)] -> Either String JsonDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sexp -> Either String JsonDoc)
-> [(Text, Sexp)] -> Either String [(Text, JsonDoc)]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> [(a, b)] -> m [(a, c)]
mapSndM Sexp -> Either String JsonDoc
sexpToJson [(Text, Sexp)]
kvs
sexpToJson (Sexp -> Maybe [Sexp]
toList -> Just [Sexp]
as) = [JsonDoc] -> JsonDoc
JSArray ([JsonDoc] -> JsonDoc)
-> Either String [JsonDoc] -> Either String JsonDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Sexp -> Either String JsonDoc)
-> [Sexp] -> Either String [JsonDoc]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Sexp -> Either String JsonDoc
sexpToJson [Sexp]
as
sexpToJson (SexpCons Sexp
_ Sexp
_) = String -> Either String JsonDoc
forall a b. a -> Either a b
Left (String -> Either String JsonDoc)
-> String -> Either String JsonDoc
forall a b. (a -> b) -> a -> b
$ String
"cons cell has no JSON equivalent"
sexpToJson (SexpString Text
s) = JsonDoc -> Either String JsonDoc
forall a b. b -> Either a b
Right (JsonDoc -> Either String JsonDoc)
-> (String -> JsonDoc) -> String -> Either String JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonDoc
JSString (String -> Either String JsonDoc)
-> String -> Either String JsonDoc
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s
sexpToJson (SexpSymbol Text
s) = JsonDoc -> Either String JsonDoc
forall a b. b -> Either a b
Right (JsonDoc -> Either String JsonDoc)
-> (String -> JsonDoc) -> String -> Either String JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> JsonDoc
JSString (String -> Either String JsonDoc)
-> String -> Either String JsonDoc
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s -- nobody said it had to roundtrip
sexpToJson (SexpInt Int
i) = JsonDoc -> Either String JsonDoc
forall a b. b -> Either a b
Right (JsonDoc -> Either String JsonDoc)
-> JsonDoc -> Either String JsonDoc
forall a b. (a -> b) -> a -> b
$ Int -> JsonDoc
JSInt Int
i
-- TODO write our own JSON repr to avoid a ghc dep and improve perf