From f506a356cec79336d516a4b5b0d1948bbce8c78b Mon Sep 17 00:00:00 2001
From: Alexander Biehl <alexbiehl@gmail.com>
Date: Wed, 30 Aug 2017 09:24:56 +0200
Subject: Write meta.json when generating html output (#676)
---
haddock-api/src/Haddock.hs | 6 ++++--
haddock-api/src/Haddock/Backends/Meta.hs | 22 ++++++++++++++++++++++
2 files changed, 26 insertions(+), 2 deletions(-)
create mode 100644 haddock-api/src/Haddock/Backends/Meta.hs
(limited to 'haddock-api/src')
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 554cb416..17951068 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -29,6 +29,7 @@ import Data.Version
import Haddock.Backends.Xhtml
import Haddock.Backends.Xhtml.Themes (getThemes)
import Haddock.Backends.LaTeX
+import Haddock.Backends.Meta
import Haddock.Backends.Hoogle
import Haddock.Backends.Hyperlinker
import Haddock.Interface
@@ -319,6 +320,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
opt_contents_url opt_index_url unicode qual
pretty
copyHtmlBits odir libDir themes
+ writeHaddockMeta odir
-- TODO: we throw away Meta for both Hoogle and LaTeX right now,
-- might want to fix that if/when these two get some work on them
@@ -445,9 +447,9 @@ getHaddockLibDir flags =
exists <- doesDirectoryExist p
pure $ if exists then Just p else Nothing
- dirs <- mapM check res_dirs
+ dirs <- mapM check res_dirs
case [p | Just p <- dirs] of
- (p : _) -> return p
+ (p : _) -> return p
_ -> die "Haddock's resource directory does not exist!\n"
#endif
fs -> return (last fs)
diff --git a/haddock-api/src/Haddock/Backends/Meta.hs b/haddock-api/src/Haddock/Backends/Meta.hs
new file mode 100644
index 00000000..c62c1ae8
--- /dev/null
+++ b/haddock-api/src/Haddock/Backends/Meta.hs
@@ -0,0 +1,22 @@
+module Haddock.Backends.Meta where
+
+import Haddock.Utils.Json
+import Haddock.Version
+
+import Data.ByteString.Builder (hPutBuilder)
+import System.FilePath ((</>))
+import System.IO (withFile, IOMode (WriteMode))
+
+-- | Writes a json encoded file containing additional
+-- information about the generated documentation. This
+-- is useful for external tools (e.g. hackage).
+writeHaddockMeta :: FilePath -> IO ()
+writeHaddockMeta odir = do
+ let
+ meta_json :: Value
+ meta_json = object [
+ "haddock_version" .= String projectVersion
+ ]
+
+ withFile (odir </> "meta.json") WriteMode $ \h ->
+ hPutBuilder h (encodeToBuilder meta_json)
\ No newline at end of file
--
cgit v1.2.3