module Haddock.Backends.Xhtml.Meta where

import Data.ByteString.Builder (hPutBuilder)
import System.FilePath ((</>))
import System.IO (IOMode (WriteMode), withFile)

import Haddock.Utils.Json
import Haddock.Version

-- | Everytime breaking changes to the Quckjump api
-- happen this needs to be modified.
quickjumpVersion :: Int
quickjumpVersion :: Int
quickjumpVersion = Int
1

-- | Writes a json encoded file containing additional
-- information about the generated documentation. This
-- is useful for external tools (e.g., Hackage).
writeHaddockMeta :: FilePath -> Bool -> IO ()
writeHaddockMeta :: FilePath -> Bool -> IO ()
writeHaddockMeta FilePath
odir Bool
withQuickjump = do
  let
    meta_json :: Value
    meta_json :: Value
meta_json =
      [Pair] -> Value
object
        ( [[Pair]] -> [Pair]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
            [ [FilePath
"haddock_version" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
.= FilePath -> Value
String FilePath
projectVersion]
            , [FilePath
"quickjump_version" FilePath -> Int -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
.= Int
quickjumpVersion | Bool
withQuickjump]
            ]
        )

  FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (FilePath
odir FilePath -> FilePath -> FilePath
</> FilePath
"meta.json") IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
    Handle -> Builder -> IO ()
hPutBuilder Handle
h (Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToBuilder Value
meta_json)