Skip to content

Commit 6d8adf1

Browse files
cootmergify[bot]
authored andcommitted
Relaxed preconditions of parsePureArgs and renderArgs
We need 'renderArgs' to work when we create an index. In this case some of the options will not be set.
1 parent 5737f11 commit 6d8adf1

File tree

1 file changed

+20
-15
lines changed

1 file changed

+20
-15
lines changed

Cabal/src/Distribution/Simple/Haddock.hs

Lines changed: 20 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -624,31 +624,33 @@ renderArgs verbosity tmpFileOpts version comp platform args k = do
624624
case o of
625625
Html -> "index.html"
626626
Hoogle -> pkgstr <.> "txt")
627-
$ arg argOutput
627+
. fromFlagOrDefault [Html]
628+
. argOutput
629+
$ args
628630
where
629631
pkgstr = prettyShow $ packageName pkgid
630632
pkgid = arg argPackageName
631633
arg f = fromFlag $ f args
632634

633635
renderPureArgs :: Version -> Compiler -> Platform -> HaddockArgs -> [String]
634636
renderPureArgs version comp platform args = concat
635-
[ (:[]) . (\f -> "--dump-interface="++ unDir (argOutputDir args) </> f)
636-
. fromFlag . argInterfaceFile $ args
637+
[ map (\f -> "--dump-interface="++ unDir (argOutputDir args) </> f)
638+
. flagToList . argInterfaceFile $ args
637639

638640
, if isVersion 2 16
639-
then (\pkg -> [ "--package-name=" ++ prettyShow (pkgName pkg)
640-
, "--package-version=" ++ prettyShow (pkgVersion pkg)
641-
])
642-
. fromFlag . argPackageName $ args
641+
then maybe [] (\pkg -> [ "--package-name=" ++ prettyShow (pkgName pkg)
642+
, "--package-version=" ++ prettyShow (pkgVersion pkg)
643+
])
644+
. flagToMaybe . argPackageName $ args
643645
else []
644646

645647
, [ "--since-qual=external" | isVersion 2 20 ]
646648

647649
, [ "--quickjump" | isVersion 2 19
648-
, fromFlag . argQuickJump $ args ]
650+
, _ <- flagToList . argQuickJump $ args ]
649651

650652
, [ "--hyperlinked-source" | isVersion 2 17
651-
, fromFlag . argLinkedSource $ args ]
653+
, True <- flagToList . argLinkedSource $ args ]
652654

653655
, (\(All b,xs) -> bool (map (("--hide=" ++) . prettyShow) xs) [] b)
654656
. argHideModules $ args
@@ -673,16 +675,19 @@ renderPureArgs version comp platform args = concat
673675
, bool [] [verbosityFlag] . getAny . argVerbose $ args
674676

675677
, map (\o -> case o of Hoogle -> "--hoogle"; Html -> "--html")
676-
. fromFlag . argOutput $ args
678+
. fromFlagOrDefault [] . argOutput $ args
677679

678680
, renderInterfaces . argInterfaces $ args
679681

680682
, (:[]) . ("--odir="++) . unDir . argOutputDir $ args
681683

682-
, (:[]) . ("--title="++)
683-
. (bool (++" (internal documentation)")
684-
id (getAny $ argIgnoreExports args))
685-
. fromFlag . argTitle $ args
684+
, maybe []
685+
( (:[])
686+
. ("--title="++)
687+
. (bool (++" (internal documentation)")
688+
id (getAny $ argIgnoreExports args))
689+
)
690+
. flagToMaybe . argTitle $ args
686691

687692
, [ "--optghc=" ++ opt | let opts = argGhcOptions args
688693
, opt <- renderGhcOptions comp platform opts ]
@@ -710,7 +715,7 @@ renderPureArgs version comp platform args = concat
710715
-- enabled
711716
, Just x <- [hypsrc]
712717
, isVersion 2 17
713-
, fromFlag . argLinkedSource $ args
718+
, fromFlagOrDefault False . argLinkedSource $ args
714719
]
715720
, [ i ]
716721
])

0 commit comments

Comments
 (0)