{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}

module HsInspect.Json where

#if MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)
import qualified GHC.Utils.Json as GHC
import qualified GHC.Utils.Monad as GHC
import qualified GHC.Utils.Outputable as GHC
import qualified GHC.Utils.Misc as GHC
#else
import qualified Json as GHC
import qualified MonadUtils as GHC
import qualified Outputable as GHC
import qualified Util as GHC
#endif

import qualified Data.Text as T
import HsInspect.Sexp

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

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