From 53c47c6fc6cdaa5084b36ea6ba8320a460fa7106 Mon Sep 17 00:00:00 2001 From: Adam Sandberg Eriksson Date: Fri, 3 Jul 2015 15:57:06 +0200 Subject: StrictData: print correct strictness marks --- haddock-api/src/Haddock/Backends/LaTeX.hs | 7 +++++-- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 8 +++++--- haddock-api/src/Haddock/Convert.hs | 8 ++++---- 3 files changed, 14 insertions(+), 9 deletions(-) (limited to 'haddock-api/src') diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index e1090a0e..86a6909b 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -823,8 +823,11 @@ pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt) ppBang :: HsBang -> LaTeX -ppBang HsNoBang = empty -ppBang _ = char '!' -- Unpacked args is an implementation detail, +ppBang HsStrict = char '!' +ppBang (HsUnpack {}) = char '!' +ppBang (HsSrcBang _ _ (Just True)) = char '!' +ppBang (HsSrcBang _ _ (Just False)) = char '~' +ppBang _ = empty tupleParens :: HsTupleSort -> [LaTeX] -> LaTeX diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index c0be9735..2da4cc1c 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -769,9 +769,11 @@ ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument" ppBang :: HsBang -> Html -ppBang HsNoBang = noHtml -ppBang _ = toHtml "!" -- Unpacked args is an implementation detail, - -- so we just show the strictness annotation +ppBang HsStrict = toHtml "!" +ppBang (HsUnpack {}) = toHtml "!" +ppBang (HsSrcBang _ _ (Just True)) = toHtml "!" +ppBang (HsSrcBang _ _ (Just False)) = toHtml "~" +ppBang _ = noHtml tupleParens :: HsTupleSort -> [Html] -> Html diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index d841aecc..c11ca545 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -269,13 +269,13 @@ synifyDataCon use_gadt_syntax dc = linear_tys = zipWith (\ty bang -> let tySyn = synifyType WithinType ty src_bang = case bang of - HsUnpack {} -> HsSrcBang Nothing (Just True) True - HsStrict -> HsSrcBang Nothing (Just False) True + HsUnpack {} -> HsSrcBang Nothing (Just True) (Just True) + HsStrict -> HsSrcBang Nothing (Just False) (Just True) + HsLazy -> HsSrcBang Nothing Nothing Nothing _ -> bang in case src_bang of - HsNoBang -> tySyn + (HsSrcBang _ Nothing Nothing) -> tySyn _ -> noLoc $ HsBangTy bang tySyn - -- HsNoBang never appears, it's implied instead. ) arg_tys (dataConSrcBangs dc) field_tys = zipWith (\field synTy -> noLoc $ ConDeclField -- cgit v1.2.3 From 5eb0785cde60997f072c3bdfefaf8c389c96d42e Mon Sep 17 00:00:00 2001 From: Adam Sandberg Eriksson Date: Wed, 8 Jul 2015 15:03:04 +0200 Subject: StrictData: changes in HsBang type --- haddock-api/src/Haddock/Backends/LaTeX.hs | 10 +++++----- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 10 +++++----- haddock-api/src/Haddock/Convert.hs | 8 ++++---- 3 files changed, 14 insertions(+), 14 deletions(-) (limited to 'haddock-api/src') diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 86a6909b..d85d75da 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -823,11 +823,11 @@ pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt) ppBang :: HsBang -> LaTeX -ppBang HsStrict = char '!' -ppBang (HsUnpack {}) = char '!' -ppBang (HsSrcBang _ _ (Just True)) = char '!' -ppBang (HsSrcBang _ _ (Just False)) = char '~' -ppBang _ = empty +ppBang HsStrict = char '!' +ppBang (HsUnpack {}) = char '!' +ppBang (HsSrcBang _ _ SrcStrict) = char '!' +ppBang (HsSrcBang _ _ SrcLazy) = char '~' +ppBang _ = empty tupleParens :: HsTupleSort -> [LaTeX] -> LaTeX diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 2da4cc1c..21ef167b 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -769,11 +769,11 @@ ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument" ppBang :: HsBang -> Html -ppBang HsStrict = toHtml "!" -ppBang (HsUnpack {}) = toHtml "!" -ppBang (HsSrcBang _ _ (Just True)) = toHtml "!" -ppBang (HsSrcBang _ _ (Just False)) = toHtml "~" -ppBang _ = noHtml +ppBang HsStrict = toHtml "!" +ppBang (HsUnpack {}) = toHtml "!" +ppBang (HsSrcBang _ _ SrcStrict) = toHtml "!" +ppBang (HsSrcBang _ _ SrcLazy) = toHtml "~" +ppBang _ = noHtml tupleParens :: HsTupleSort -> [Html] -> Html diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index c11ca545..edf91ce5 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -269,12 +269,12 @@ synifyDataCon use_gadt_syntax dc = linear_tys = zipWith (\ty bang -> let tySyn = synifyType WithinType ty src_bang = case bang of - HsUnpack {} -> HsSrcBang Nothing (Just True) (Just True) - HsStrict -> HsSrcBang Nothing (Just False) (Just True) - HsLazy -> HsSrcBang Nothing Nothing Nothing + HsUnpack {} -> HsSrcBang Nothing SrcUnpack SrcStrict + HsStrict -> HsSrcBang Nothing SrcNoUnpack SrcStrict + HsLazy -> HsSrcBang Nothing NoSrcUnpack NoSrcStrictness _ -> bang in case src_bang of - (HsSrcBang _ Nothing Nothing) -> tySyn + (HsSrcBang _ NoSrcUnpack NoSrcStrictness) -> tySyn _ -> noLoc $ HsBangTy bang tySyn ) arg_tys (dataConSrcBangs dc) -- cgit v1.2.3