module Dhall.LSP.Backend.ToJSON (CompileError, toJSON) where

import Data.ByteString.Lazy    (toStrict)
import Data.Text               (Text)
import Data.Text.Encoding      (decodeUtf8)
import Dhall.JSON              as Dhall
import Dhall.LSP.Backend.Dhall

import qualified Data.Aeson.Encode.Pretty as Aeson

-- | Try to convert a given Dhall expression to JSON.
toJSON :: WellTyped -> Either CompileError Text
toJSON :: WellTyped -> Either CompileError Text
toJSON WellTyped
expr = (Value -> Text)
-> Either CompileError Value -> Either CompileError Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
Aeson.encodePretty' Config
config)
                (Expr Src Void -> Either CompileError Value
forall s. Expr s Void -> Either CompileError Value
Dhall.dhallToJSON (Expr Src Void -> Either CompileError Value)
-> Expr Src Void -> Either CompileError Value
forall a b. (a -> b) -> a -> b
$ WellTyped -> Expr Src Void
fromWellTyped WellTyped
expr)
  where
    config :: Config
config = Config :: Indent
-> (Text -> Text -> Ordering) -> NumberFormat -> Bool -> Config
Aeson.Config
              { confIndent :: Indent
Aeson.confIndent = Int -> Indent
Aeson.Spaces Int
2
              , confCompare :: Text -> Text -> Ordering
Aeson.confCompare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
              , confNumFormat :: NumberFormat
Aeson.confNumFormat = NumberFormat
Aeson.Generic
              , confTrailingNewline :: Bool
Aeson.confTrailingNewline = Bool
False }