aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYuchen Pei <hi@ypei.me>2022-08-16 12:18:12 +1000
committerYuchen Pei <hi@ypei.me>2022-08-16 13:55:46 +1000
commitfaf6936079ba15570fe4e6835d9380d79986d011 (patch)
treedc431f6410c147d59103566f79511d88adb92180
parente5bfddc32ab28675c20014e4f7c3878258317752 (diff)
Moving file writing to inside org backend
Also handling odir now
-rw-r--r--haddock-api/src/Haddock.hs7
-rw-r--r--haddock-api/src/Haddock/Backends/Org.hs26
2 files changed, 24 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index d011078a..581793d0 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -472,9 +472,10 @@ render log' dflags unit_state flags sinceQual qual ifaces installedIfaces extSrc
libDir
return ()
when (Flag_Org `elem` flags) $ do
- withTiming logger "ppOrg" (const ()) $ do
- let org = {-# SCC ppOrg #-} ppOrg title (_doc <$> prologue) (fromJust pkgStr) visibleIfaces
- writeUtf8File (fromMaybe "haddock" (cleanPkgStr <$> pkgStr) <.> "org") org
+ withTiming logger dflags' "ppOrg" (const ()) $ do
+ _ <- {-# SCC ppOrg #-}
+ ppOrg title pkgStr odir (_doc <$> prologue) visibleIfaces
+ return ()
when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
withTiming logger "ppHyperlinkedSource" (const ()) $ do
diff --git a/haddock-api/src/Haddock/Backends/Org.hs b/haddock-api/src/Haddock/Backends/Org.hs
index 62c3a98d..1068c0fe 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