{-# LANGUAGE RecordWildCards #-}
module Haddock.Interface.Json (
    jsonInstalledInterface
  , jsonInterfaceFile
  , renderJson
  ) where

import BasicTypes
import Json
import Module
import Name
import Outputable

import Control.Arrow
import Data.Map (Map)
import qualified Data.Map as Map

import Haddock.Types
import Haddock.InterfaceFile

jsonInterfaceFile :: InterfaceFile -> JsonDoc
jsonInterfaceFile :: InterfaceFile -> JsonDoc
jsonInterfaceFile InterfaceFile{[InstalledInterface]
LinkEnv
ifInstalledIfaces :: InterfaceFile -> [InstalledInterface]
ifLinkEnv :: InterfaceFile -> LinkEnv
ifInstalledIfaces :: [InstalledInterface]
ifLinkEnv :: LinkEnv
..} =
  [(String, JsonDoc)] -> JsonDoc
jsonObject [ (String
"link_env" , (Name -> String) -> (Module -> JsonDoc) -> LinkEnv -> JsonDoc
forall a b. (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap Name -> String
nameStableString (String -> JsonDoc
jsonString (String -> JsonDoc) -> (Module -> String) -> Module -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (Module -> ModuleName) -> Module -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
moduleName) LinkEnv
ifLinkEnv)
             , (String
"inst_ifaces", [JsonDoc] -> JsonDoc
jsonArray ((InstalledInterface -> JsonDoc)
-> [InstalledInterface] -> [JsonDoc]
forall a b. (a -> b) -> [a] -> [b]
map InstalledInterface -> JsonDoc
jsonInstalledInterface [InstalledInterface]
ifInstalledIfaces))
             ]

jsonInstalledInterface :: InstalledInterface -> JsonDoc
jsonInstalledInterface :: InstalledInterface -> JsonDoc
jsonInstalledInterface InstalledInterface{Bool
[Name]
[DocOption]
ArgMap Name
Map Name Fixity
DocMap Name
Module
HaddockModInfo Name
instFixMap :: InstalledInterface -> Map Name Fixity
instOptions :: InstalledInterface -> [DocOption]
instVisibleExports :: InstalledInterface -> [Name]
instExports :: InstalledInterface -> [Name]
instArgMap :: InstalledInterface -> ArgMap Name
instDocMap :: InstalledInterface -> DocMap Name
instInfo :: InstalledInterface -> HaddockModInfo Name
instIsSig :: InstalledInterface -> Bool
instMod :: InstalledInterface -> Module
instFixMap :: Map Name Fixity
instOptions :: [DocOption]
instVisibleExports :: [Name]
instExports :: [Name]
instArgMap :: ArgMap Name
instDocMap :: DocMap Name
instInfo :: HaddockModInfo Name
instIsSig :: Bool
instMod :: Module
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject [(String, JsonDoc)]
properties
  where
    properties :: [(String, JsonDoc)]
properties =
      [ (String
"module"          , Module -> JsonDoc
jsonModule Module
instMod)
      , (String
"is_sig"          , Bool -> JsonDoc
jsonBool Bool
instIsSig)
      , (String
"info"            , HaddockModInfo Name -> JsonDoc
jsonHaddockModInfo HaddockModInfo Name
instInfo)
      , (String
"doc_map"         , (Name -> String)
-> (MDoc Name -> JsonDoc) -> DocMap Name -> JsonDoc
forall a b. (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap Name -> String
nameStableString MDoc Name -> JsonDoc
jsonMDoc DocMap Name
instDocMap)
      , (String
"arg_map"         , (Name -> String)
-> (Map Int (MDoc Name) -> JsonDoc) -> ArgMap Name -> JsonDoc
forall a b. (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap Name -> String
nameStableString ((Int -> String)
-> (MDoc Name -> JsonDoc) -> Map Int (MDoc Name) -> JsonDoc
forall a b. (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap Int -> String
forall a. Show a => a -> String
show MDoc Name -> JsonDoc
jsonMDoc) ArgMap Name
instArgMap)
      , (String
"exports"         , [JsonDoc] -> JsonDoc
jsonArray ((Name -> JsonDoc) -> [Name] -> [JsonDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> JsonDoc
jsonName [Name]
instExports))
      , (String
"visible_exports" , [JsonDoc] -> JsonDoc
jsonArray ((Name -> JsonDoc) -> [Name] -> [JsonDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> JsonDoc
jsonName [Name]
instVisibleExports))
      , (String
"options"         , [JsonDoc] -> JsonDoc
jsonArray ((DocOption -> JsonDoc) -> [DocOption] -> [JsonDoc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> JsonDoc
jsonString (String -> JsonDoc)
-> (DocOption -> String) -> DocOption -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocOption -> String
forall a. Show a => a -> String
show) [DocOption]
instOptions))
      , (String
"fix_map"         , (Name -> String)
-> (Fixity -> JsonDoc) -> Map Name Fixity -> JsonDoc
forall a b. (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap Name -> String
nameStableString Fixity -> JsonDoc
jsonFixity Map Name Fixity
instFixMap)
      ]

jsonHaddockModInfo :: HaddockModInfo Name -> JsonDoc
jsonHaddockModInfo :: HaddockModInfo Name -> JsonDoc
jsonHaddockModInfo HaddockModInfo{[Extension]
Maybe String
Maybe Language
Maybe (Doc Name)
hmi_extensions :: forall name. HaddockModInfo name -> [Extension]
hmi_language :: forall name. HaddockModInfo name -> Maybe Language
hmi_safety :: forall name. HaddockModInfo name -> Maybe String
hmi_portability :: forall name. HaddockModInfo name -> Maybe String
hmi_stability :: forall name. HaddockModInfo name -> Maybe String
hmi_maintainer :: forall name. HaddockModInfo name -> Maybe String
hmi_license :: forall name. HaddockModInfo name -> Maybe String
hmi_copyright :: forall name. HaddockModInfo name -> Maybe String
hmi_description :: forall name. HaddockModInfo name -> Maybe (Doc name)
hmi_extensions :: [Extension]
hmi_language :: Maybe Language
hmi_safety :: Maybe String
hmi_portability :: Maybe String
hmi_stability :: Maybe String
hmi_maintainer :: Maybe String
hmi_license :: Maybe String
hmi_copyright :: Maybe String
hmi_description :: Maybe (Doc Name)
..} =
  [(String, JsonDoc)] -> JsonDoc
jsonObject [ (String
"description" , (Doc Name -> JsonDoc) -> Maybe (Doc Name) -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe Doc Name -> JsonDoc
jsonDoc Maybe (Doc Name)
hmi_description)
             , (String
"copyright"   , (String -> JsonDoc) -> Maybe String -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe String -> JsonDoc
jsonString Maybe String
hmi_copyright)
             , (String
"maintainer"  , (String -> JsonDoc) -> Maybe String -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe String -> JsonDoc
jsonString Maybe String
hmi_maintainer)
             , (String
"stability"   , (String -> JsonDoc) -> Maybe String -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe String -> JsonDoc
jsonString Maybe String
hmi_stability)
             , (String
"protability" , (String -> JsonDoc) -> Maybe String -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe String -> JsonDoc
jsonString Maybe String
hmi_portability)
             , (String
"safety"      , (String -> JsonDoc) -> Maybe String -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe String -> JsonDoc
jsonString Maybe String
hmi_safety)
             , (String
"language"    , (Language -> JsonDoc) -> Maybe Language -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe (String -> JsonDoc
jsonString (String -> JsonDoc) -> (Language -> String) -> Language -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> String
forall a. Show a => a -> String
show) Maybe Language
hmi_language)
             , (String
"extensions"  , [JsonDoc] -> JsonDoc
jsonArray ((Extension -> JsonDoc) -> [Extension] -> [JsonDoc]
forall a b. (a -> b) -> [a] -> [b]
map (String -> JsonDoc
jsonString (String -> JsonDoc)
-> (Extension -> String) -> Extension -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
forall a. Show a => a -> String
show) [Extension]
hmi_extensions))
             ]

jsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap a -> String
f b -> JsonDoc
g = [(String, JsonDoc)] -> JsonDoc
jsonObject ([(String, JsonDoc)] -> JsonDoc)
-> (Map a b -> [(String, JsonDoc)]) -> Map a b -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (String, JsonDoc)) -> [(a, b)] -> [(String, JsonDoc)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> String
f (a -> String) -> (b -> JsonDoc) -> (a, b) -> (String, JsonDoc)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** b -> JsonDoc
g) ([(a, b)] -> [(String, JsonDoc)])
-> (Map a b -> [(a, b)]) -> Map a b -> [(String, JsonDoc)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
Map.toList

jsonMDoc :: MDoc Name -> JsonDoc
jsonMDoc :: MDoc Name -> JsonDoc
jsonMDoc MetaDoc{Meta
Doc Name
_meta :: forall mod id. MetaDoc mod id -> Meta
_doc :: forall mod id. MetaDoc mod id -> DocH mod id
_doc :: Doc Name
_meta :: Meta
..} =
  [(String, JsonDoc)] -> JsonDoc
jsonObject [ (String
"meta", [(String, JsonDoc)] -> JsonDoc
jsonObject [(String
"version", (Version -> JsonDoc) -> Maybe Version -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe (String -> JsonDoc
jsonString (String -> JsonDoc) -> (Version -> String) -> Version -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Show a => a -> String
show) (Meta -> Maybe Version
_version Meta
_meta))])
             , (String
"document",  Doc Name -> JsonDoc
jsonDoc Doc Name
_doc)
             ]

showModName :: Wrap (ModuleName, OccName) -> String
showModName :: Wrap (ModuleName, OccName) -> String
showModName = ((ModuleName, OccName) -> String)
-> Wrap (ModuleName, OccName) -> String
forall a. (a -> String) -> Wrap a -> String
showWrapped (ModuleName -> String
moduleNameString (ModuleName -> String)
-> ((ModuleName, OccName) -> ModuleName)
-> (ModuleName, OccName)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, OccName) -> ModuleName
forall a b. (a, b) -> a
fst)

showName :: Wrap Name -> String
showName :: Wrap Name -> String
showName = (Name -> String) -> Wrap Name -> String
forall a. (a -> String) -> Wrap a -> String
showWrapped Name -> String
nameStableString


jsonDoc :: Doc Name -> JsonDoc

jsonDoc :: Doc Name -> JsonDoc
jsonDoc Doc Name
DocEmpty = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocEmpty") ]

jsonDoc (DocAppend Doc Name
x Doc Name
y) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocAppend")
    , (String
"first", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    , (String
"second", Doc Name -> JsonDoc
jsonDoc Doc Name
y)
    ]

jsonDoc (DocString String
s) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocString")
    , (String
"string", String -> JsonDoc
jsonString String
s)
    ]

jsonDoc (DocParagraph Doc Name
x) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocParagraph")
    , (String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    ]

jsonDoc (DocIdentifier Wrap Name
name) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocIdentifier")
    , (String
"name", String -> JsonDoc
jsonString (Wrap Name -> String
showName Wrap Name
name))
    ]

jsonDoc (DocIdentifierUnchecked Wrap (ModuleName, OccName)
modName) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocIdentifierUnchecked")
    , (String
"modName", String -> JsonDoc
jsonString (Wrap (ModuleName, OccName) -> String
showModName Wrap (ModuleName, OccName)
modName))
    ]

jsonDoc (DocModule (ModLink String
m Maybe (Doc Name)
_l)) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocModule")
    , (String
"string", String -> JsonDoc
jsonString String
m)
    ]

jsonDoc (DocWarning Doc Name
x) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocWarning")
    , (String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    ]

jsonDoc (DocEmphasis Doc Name
x) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocEmphasis")
    , (String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    ]

jsonDoc (DocMonospaced Doc Name
x) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocMonospaced")
    , (String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    ]

jsonDoc (DocBold Doc Name
x) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocBold")
    , (String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    ]

jsonDoc (DocUnorderedList [Doc Name]
xs) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocUnorderedList")
    , (String
"documents", [JsonDoc] -> JsonDoc
jsonArray ((Doc Name -> JsonDoc) -> [Doc Name] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Name -> JsonDoc
jsonDoc [Doc Name]
xs))
    ]

jsonDoc (DocOrderedList [Doc Name]
xs) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocOrderedList")
    , (String
"documents", [JsonDoc] -> JsonDoc
jsonArray ((Doc Name -> JsonDoc) -> [Doc Name] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc Name -> JsonDoc
jsonDoc [Doc Name]
xs))
    ]

jsonDoc (DocDefList [(Doc Name, Doc Name)]
xys) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocDefList")
    , (String
"definitions", [JsonDoc] -> JsonDoc
jsonArray (((Doc Name, Doc Name) -> JsonDoc)
-> [(Doc Name, Doc Name)] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc Name, Doc Name) -> JsonDoc
jsonDef [(Doc Name, Doc Name)]
xys))
    ]
  where
    jsonDef :: (Doc Name, Doc Name) -> JsonDoc
jsonDef (Doc Name
x, Doc Name
y) = [(String, JsonDoc)] -> JsonDoc
jsonObject [(String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x), (String
"y", Doc Name -> JsonDoc
jsonDoc Doc Name
y)]

jsonDoc (DocCodeBlock Doc Name
x) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocCodeBlock")
    , (String
"document", Doc Name -> JsonDoc
jsonDoc Doc Name
x)
    ]

jsonDoc (DocHyperlink Hyperlink (Doc Name)
hyperlink) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocHyperlink")
    , (String
"hyperlink", Hyperlink (Doc Name) -> JsonDoc
jsonHyperlink Hyperlink (Doc Name)
hyperlink)
    ]
  where
    jsonHyperlink :: Hyperlink (Doc Name) -> JsonDoc
jsonHyperlink Hyperlink{String
Maybe (Doc Name)
hyperlinkUrl :: forall id. Hyperlink id -> String
hyperlinkLabel :: forall id. Hyperlink id -> Maybe id
hyperlinkLabel :: Maybe (Doc Name)
hyperlinkUrl :: String
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject
        [ (String
"hyperlinkUrl", String -> JsonDoc
jsonString String
hyperlinkUrl)
        , (String
"hyperlinkLabel", (Doc Name -> JsonDoc) -> Maybe (Doc Name) -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe Doc Name -> JsonDoc
jsonDoc Maybe (Doc Name)
hyperlinkLabel)
        ]

jsonDoc (DocPic Picture
picture) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocPic")
    , (String
"picture", Picture -> JsonDoc
jsonPicture Picture
picture)
    ]
  where
    jsonPicture :: Picture -> JsonDoc
jsonPicture Picture{String
Maybe String
pictureUri :: Picture -> String
pictureTitle :: Picture -> Maybe String
pictureTitle :: Maybe String
pictureUri :: String
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject
        [ (String
"pictureUrl", String -> JsonDoc
jsonString String
pictureUri)
        , (String
"pictureLabel", (String -> JsonDoc) -> Maybe String -> JsonDoc
forall a. (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe String -> JsonDoc
jsonString Maybe String
pictureTitle)
        ]

jsonDoc (DocMathInline String
s) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocMathInline")
    , (String
"string", String -> JsonDoc
jsonString String
s)
    ]

jsonDoc (DocMathDisplay String
s) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocMathDisplay")
    , (String
"string", String -> JsonDoc
jsonString String
s)
    ]

jsonDoc (DocAName String
s) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocAName")
    , (String
"string", String -> JsonDoc
jsonString String
s)
    ]

jsonDoc (DocProperty String
s) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocProperty")
    , (String
"string", String -> JsonDoc
jsonString String
s)
    ]

jsonDoc (DocExamples [Example]
examples) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocExamples")
    , (String
"examples", [JsonDoc] -> JsonDoc
jsonArray ((Example -> JsonDoc) -> [Example] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Example -> JsonDoc
jsonExample [Example]
examples))
    ]
  where
    jsonExample :: Example -> JsonDoc
jsonExample Example{String
[String]
exampleExpression :: Example -> String
exampleResult :: Example -> [String]
exampleResult :: [String]
exampleExpression :: String
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject
        [ (String
"exampleExpression", String -> JsonDoc
jsonString String
exampleExpression)
        , (String
"exampleResult", [JsonDoc] -> JsonDoc
jsonArray ((String -> JsonDoc) -> [String] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> JsonDoc
jsonString [String]
exampleResult))
        ]

jsonDoc (DocHeader Header (Doc Name)
header) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocHeader")
    , (String
"header", Header (Doc Name) -> JsonDoc
jsonHeader Header (Doc Name)
header)
    ]
  where
    jsonHeader :: Header (Doc Name) -> JsonDoc
jsonHeader Header{Int
Doc Name
headerLevel :: forall id. Header id -> Int
headerTitle :: forall id. Header id -> id
headerTitle :: Doc Name
headerLevel :: Int
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject
        [ (String
"headerLevel", Int -> JsonDoc
jsonInt Int
headerLevel)
        , (String
"headerTitle", Doc Name -> JsonDoc
jsonDoc Doc Name
headerTitle)
        ]

jsonDoc (DocTable Table (Doc Name)
table) = [(String, JsonDoc)] -> JsonDoc
jsonObject
    [ (String
"tag", String -> JsonDoc
jsonString String
"DocTable")
    , (String
"table", Table (Doc Name) -> JsonDoc
jsonTable Table (Doc Name)
table)
    ]
  where
    jsonTable :: Table (Doc Name) -> JsonDoc
jsonTable Table{[TableRow (Doc Name)]
tableHeaderRows :: forall id. Table id -> [TableRow id]
tableBodyRows :: forall id. Table id -> [TableRow id]
tableBodyRows :: [TableRow (Doc Name)]
tableHeaderRows :: [TableRow (Doc Name)]
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject
        [ (String
"tableHeaderRows", [JsonDoc] -> JsonDoc
jsonArray ((TableRow (Doc Name) -> JsonDoc)
-> [TableRow (Doc Name)] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableRow (Doc Name) -> JsonDoc
jsonTableRow [TableRow (Doc Name)]
tableHeaderRows))
        , (String
"tableBodyRows", [JsonDoc] -> JsonDoc
jsonArray ((TableRow (Doc Name) -> JsonDoc)
-> [TableRow (Doc Name)] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableRow (Doc Name) -> JsonDoc
jsonTableRow [TableRow (Doc Name)]
tableBodyRows))
        ]

    jsonTableRow :: TableRow (Doc Name) -> JsonDoc
jsonTableRow TableRow{[TableCell (Doc Name)]
tableRowCells :: forall id. TableRow id -> [TableCell id]
tableRowCells :: [TableCell (Doc Name)]
..} = [JsonDoc] -> JsonDoc
jsonArray ((TableCell (Doc Name) -> JsonDoc)
-> [TableCell (Doc Name)] -> [JsonDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableCell (Doc Name) -> JsonDoc
jsonTableCell [TableCell (Doc Name)]
tableRowCells)

    jsonTableCell :: TableCell (Doc Name) -> JsonDoc
jsonTableCell TableCell{Int
Doc Name
tableCellColspan :: forall id. TableCell id -> Int
tableCellRowspan :: forall id. TableCell id -> Int
tableCellContents :: forall id. TableCell id -> id
tableCellContents :: Doc Name
tableCellRowspan :: Int
tableCellColspan :: Int
..} = [(String, JsonDoc)] -> JsonDoc
jsonObject
        [ (String
"tableCellColspan", Int -> JsonDoc
jsonInt Int
tableCellColspan)
        , (String
"tableCellRowspan", Int -> JsonDoc
jsonInt Int
tableCellRowspan)
        , (String
"tableCellContents", Doc Name -> JsonDoc
jsonDoc Doc Name
tableCellContents)
        ]


jsonModule :: Module -> JsonDoc
jsonModule :: Module -> JsonDoc
jsonModule = String -> JsonDoc
JSString (String -> JsonDoc) -> (Module -> String) -> Module -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> String
moduleStableString

jsonName :: Name -> JsonDoc
jsonName :: Name -> JsonDoc
jsonName = String -> JsonDoc
JSString (String -> JsonDoc) -> (Name -> String) -> Name -> JsonDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> String
nameStableString

jsonFixity :: Fixity -> JsonDoc
jsonFixity :: Fixity -> JsonDoc
jsonFixity (Fixity SourceText
_ Int
prec FixityDirection
dir) =
  [(String, JsonDoc)] -> JsonDoc
jsonObject [ (String
"prec"      , Int -> JsonDoc
jsonInt Int
prec)
             , (String
"direction" , FixityDirection -> JsonDoc
jsonFixityDirection FixityDirection
dir)
             ]

jsonFixityDirection :: FixityDirection -> JsonDoc
jsonFixityDirection :: FixityDirection -> JsonDoc
jsonFixityDirection FixityDirection
InfixL = String -> JsonDoc
jsonString String
"infixl"
jsonFixityDirection FixityDirection
InfixR = String -> JsonDoc
jsonString String
"infixr"
jsonFixityDirection FixityDirection
InfixN = String -> JsonDoc
jsonString String
"infix"

renderJson :: JsonDoc -> SDoc
renderJson :: JsonDoc -> SDoc
renderJson = JsonDoc -> SDoc
renderJSON

jsonMaybe :: (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe :: (a -> JsonDoc) -> Maybe a -> JsonDoc
jsonMaybe = JsonDoc -> (a -> JsonDoc) -> Maybe a -> JsonDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe JsonDoc
jsonNull

jsonString :: String -> JsonDoc
jsonString :: String -> JsonDoc
jsonString = String -> JsonDoc
JSString

jsonObject :: [(String, JsonDoc)] -> JsonDoc
jsonObject :: [(String, JsonDoc)] -> JsonDoc
jsonObject = [(String, JsonDoc)] -> JsonDoc
JSObject

jsonArray :: [JsonDoc] -> JsonDoc
jsonArray :: [JsonDoc] -> JsonDoc
jsonArray = [JsonDoc] -> JsonDoc
JSArray

jsonNull :: JsonDoc
jsonNull :: JsonDoc
jsonNull = JsonDoc
JSNull

jsonInt :: Int -> JsonDoc
jsonInt :: Int -> JsonDoc
jsonInt = Int -> JsonDoc
JSInt

jsonBool :: Bool -> JsonDoc
jsonBool :: Bool -> JsonDoc
jsonBool = Bool -> JsonDoc
JSBool