From 6c53280b8d723acdff83e6333620b0958f8b600e Mon Sep 17 00:00:00 2001 From: Yuchen Pei Date: Tue, 16 Aug 2022 12:18:12 +1000 Subject: Moving file writing to inside org backend Also handling odir now --- haddock-api/src/Haddock.hs | 5 +++-- haddock-api/src/Haddock/Backends/Org.hs | 26 ++++++++++++++++++++------ 2 files changed, 23 insertions(+), 8 deletions(-) diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 65d329e2..fff8b923 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -506,8 +506,9 @@ render logger dflags unit_state flags sinceQual qual ifaces packages extSrcMap = return () when (Flag_Org `elem` flags) $ do withTiming logger dflags' "ppOrg" (const ()) $ do - let org = {-# SCC ppOrg #-} ppOrg title (_doc <$> prologue) (fromJust pkgStr) visibleIfaces - writeUtf8File (fromMaybe "haddock" (cleanPkgStr <$> pkgStr) <.> "org") org + _ <- {-# SCC ppOrg #-} + ppOrg title pkgStr odir (_doc <$> prologue) visibleIfaces + return () when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do withTiming logger dflags' "ppHyperlinkedSource" (const ()) $ do diff --git a/haddock-api/src/Haddock/Backends/Org.hs b/haddock-api/src/Haddock/Backends/Org.hs index b6e26ab5..76924210 100644 --- a/haddock-api/src/Haddock/Backends/Org.hs +++ b/haddock-api/src/Haddock/Backends/Org.hs @@ -24,7 +24,6 @@ License along with this file. If not, see module Haddock.Backends.Org ( ppOrg - , cleanPkgStr ) where import Control.Monad.State.Strict ( State , evalState @@ -151,7 +150,10 @@ import qualified Haddock.Types as HT ( Example(..) , Table(..) ) +import Haddock.Utils ( writeUtf8File ) import Prelude hiding ( (<>) ) +import System.Directory +import System.FilePath type PDoc = Pretty.Doc @@ -174,11 +176,23 @@ emptyDoc :: DocForDecl DocName emptyDoc = (Documentation Nothing Nothing, M.empty) -- The main function -ppOrg :: String -> Maybe (Doc RdrName) -> String -> [Interface] -> String -ppOrg title mbPrologue pkgId = orgToString . fromOrgDocument . toOrgDocument - title - mbPrologue - (cleanPkgStr pkgId) +ppOrg + :: String + -> Maybe String + -> FilePath + -> Maybe (Doc RdrName) + -> [Interface] + -> IO () +ppOrg title pkgStr odir mbPrologue ifaces = + let org = orgToString $ fromOrgDocument $ toOrgDocument + title + mbPrologue + (fromMaybe "" (cleanPkgStr <$> pkgStr)) + ifaces + in createDirectoryIfMissing True odir + >> writeUtf8File + (odir (fromMaybe "haddock" (cleanPkgStr <$> pkgStr) <.> "org")) + org toOrgDocument :: String -> Maybe (Doc RdrName) -> String -> [Interface] -> OrgDocument -- cgit v1.2.3