From d6d4c8ad32ef751ced0adb36ea67e1dd1278c0b6 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <hi@ypei.me>
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(-)

(limited to 'haddock-api')

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 038d31d9..bdcdf83c 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -466,8 +466,9 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS
       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 84d48cf0..70231743 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