Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
-
c32de3b0
by Johan Förberg at 2025-12-15T02:36:03-05:00
-
4f8b660c
by mangoiv at 2025-12-15T02:37:05-05:00
-
b8fba2c4
by Cheng Shao at 2025-12-15T04:41:10-05:00
-
e944795c
by Marc Scholten at 2025-12-15T04:41:25-05:00
10 changed files:
- .gitlab-ci.yml
- docs/users_guide/ghci.rst
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- utils/haddock/haddock-api/haddock-api.cabal
- − utils/haddock/haddock-api/src/Haddock/Backends/HaddockDB.hs
Changes:
| ... | ... | @@ -524,6 +524,7 @@ test-cabal-reinstall-x86_64-linux-deb10: |
| 524 | 524 | TEST_ENV: "x86_64-linux-deb10-cabal-install"
|
| 525 | 525 | rules:
|
| 526 | 526 | - if: $NIGHTLY
|
| 527 | + allow_failure: true
|
|
| 527 | 528 | - if: '$CI_MERGE_REQUEST_LABELS =~ /.*test-reinstall.*/'
|
| 528 | 529 | |
| 529 | 530 | ########################################
|
| ... | ... | @@ -1216,10 +1216,6 @@ Stack Traces in GHCi |
| 1216 | 1216 | .. index::
|
| 1217 | 1217 | simple: stack trace; in GHCi
|
| 1218 | 1218 | |
| 1219 | -[ This is an experimental feature enabled by the new
|
|
| 1220 | -``-fexternal-interpreter`` flag that was introduced in GHC 8.0.1. It
|
|
| 1221 | -is currently not supported on Windows.]
|
|
| 1222 | - |
|
| 1223 | 1219 | GHCi can use the profiling system to collect stack trace information
|
| 1224 | 1220 | when running interpreted code. To gain access to stack traces, start
|
| 1225 | 1221 | GHCi like this:
|
| ... | ... | @@ -14,6 +14,7 @@ |
| 14 | 14 | * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339))
|
| 15 | 15 | * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335)
|
| 16 | 16 | * Add `nubOrd` / `nubOrdBy` to `Data.List` and `Data.List.NonEmpty`. ([CLC proposal #336](https://github.com/haskell/core-libraries-committee/issues/336))
|
| 17 | + * Add `Semigroup` and `Monoid` instances for `Control.Monad.ST.Lazy`. ([CLC proposal #374](https://github.com/haskell/core-libraries-committee/issues/374))
|
|
| 17 | 18 | |
| 18 | 19 | ## 4.22.0.0 *TBA*
|
| 19 | 20 | * Shipped with GHC 9.14.1
|
| ... | ... | @@ -214,6 +214,14 @@ fixST m = ST (\ s -> |
| 214 | 214 | instance MonadFix (ST s) where
|
| 215 | 215 | mfix = fixST
|
| 216 | 216 | |
| 217 | +-- | @since base-4.23.0.0
|
|
| 218 | +instance Semigroup a => Semigroup (ST s a) where
|
|
| 219 | + (<>) = liftA2 (<>)
|
|
| 220 | + |
|
| 221 | +-- | @since base-4.23.0.0
|
|
| 222 | +instance Monoid a => Monoid (ST s a) where
|
|
| 223 | + mempty = pure mempty
|
|
| 224 | + |
|
| 217 | 225 | -- ---------------------------------------------------------------------------
|
| 218 | 226 | -- Strict <--> Lazy
|
| 219 | 227 |
| ... | ... | @@ -11318,6 +11318,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Mo |
| 11318 | 11318 | instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 11319 | 11319 | instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 11320 | 11320 | instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 11321 | +instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 11321 | 11322 | instance GHC.Internal.Base.Monoid Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 11322 | 11323 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 11323 | 11324 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -11372,6 +11373,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base |
| 11372 | 11373 | instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 11373 | 11374 | instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 11374 | 11375 | instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 11376 | +instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 11375 | 11377 | instance GHC.Internal.Base.Semigroup Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 11376 | 11378 | instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 11377 | 11379 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -14364,6 +14364,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Mo |
| 14364 | 14364 | instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 14365 | 14365 | instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 14366 | 14366 | instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 14367 | +instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 14367 | 14368 | instance GHC.Internal.Base.Monoid Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 14368 | 14369 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 14369 | 14370 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -14415,6 +14416,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base |
| 14415 | 14416 | instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 14416 | 14417 | instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 14417 | 14418 | instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 14419 | +instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 14418 | 14420 | instance GHC.Internal.Base.Semigroup Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 14419 | 14421 | instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 14420 | 14422 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -11580,6 +11580,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Mo |
| 11580 | 11580 | instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 11581 | 11581 | instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 11582 | 11582 | instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 11583 | +instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 11583 | 11584 | instance GHC.Internal.Base.Monoid Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 11584 | 11585 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 11585 | 11586 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -11632,6 +11633,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base |
| 11632 | 11633 | instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 11633 | 11634 | instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 11634 | 11635 | instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 11636 | +instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 11635 | 11637 | instance GHC.Internal.Base.Semigroup Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 11636 | 11638 | instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 11637 | 11639 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -11318,6 +11318,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Monoid a => GHC.Internal.Base.Mo |
| 11318 | 11318 | instance forall a. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 11319 | 11319 | instance GHC.Internal.Base.Monoid GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 11320 | 11320 | instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 11321 | +instance forall a s. GHC.Internal.Base.Monoid a => GHC.Internal.Base.Monoid (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 11321 | 11322 | instance GHC.Internal.Base.Monoid Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 11322 | 11323 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 11323 | 11324 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Monoid (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -11372,6 +11373,7 @@ instance forall a k (b :: k). GHC.Internal.Base.Semigroup a => GHC.Internal.Base |
| 11372 | 11373 | instance forall a. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Conc.Sync.STM a) -- Defined in ‘GHC.Internal.Conc.Sync’
|
| 11373 | 11374 | instance GHC.Internal.Base.Semigroup GHC.Internal.Exception.Context.ExceptionContext -- Defined in ‘GHC.Internal.Exception.Context’
|
| 11374 | 11375 | instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.ST.ST s a) -- Defined in ‘GHC.Internal.ST’
|
| 11376 | +instance forall a s. GHC.Internal.Base.Semigroup a => GHC.Internal.Base.Semigroup (GHC.Internal.Control.Monad.ST.Lazy.Imp.ST s a) -- Defined in ‘GHC.Internal.Control.Monad.ST.Lazy.Imp’
|
|
| 11375 | 11377 | instance GHC.Internal.Base.Semigroup Data.Array.Byte.ByteArray -- Defined in ‘Data.Array.Byte’
|
| 11376 | 11378 | instance forall a. GHC.Internal.Bits.Bits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.And a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| 11377 | 11379 | instance forall a. GHC.Internal.Bits.FiniteBits a => GHC.Internal.Base.Semigroup (GHC.Internal.Data.Bits.Iff a) -- Defined in ‘GHC.Internal.Data.Bits’
|
| ... | ... | @@ -139,7 +139,6 @@ library |
| 139 | 139 | Haddock.Backends.Xhtml.Types
|
| 140 | 140 | Haddock.Backends.Xhtml.Utils
|
| 141 | 141 | Haddock.Backends.LaTeX
|
| 142 | - Haddock.Backends.HaddockDB
|
|
| 143 | 142 | Haddock.Backends.Hoogle
|
| 144 | 143 | Haddock.Backends.Hyperlinker
|
| 145 | 144 | Haddock.Backends.Hyperlinker.Parser
|
| 1 | ------------------------------------------------------------------------------
|
|
| 2 | - |
|
| 3 | ------------------------------------------------------------------------------
|
|
| 4 | - |
|
| 5 | --- |
|
|
| 6 | --- Module : Haddock.Backends.HaddockDB
|
|
| 7 | --- Copyright : (c) Simon Marlow 2003
|
|
| 8 | --- License : BSD-like
|
|
| 9 | ---
|
|
| 10 | --- Maintainer : haddock@projects.haskell.org
|
|
| 11 | --- Stability : experimental
|
|
| 12 | --- Portability : portable
|
|
| 13 | -module Haddock.Backends.HaddockDB (ppDocBook) where
|
|
| 14 | - |
|
| 15 | -{-
|
|
| 16 | -import HaddockTypes
|
|
| 17 | -import HaddockUtil
|
|
| 18 | -import HsSyn2
|
|
| 19 | - |
|
| 20 | -import Text.PrettyPrint
|
|
| 21 | --}
|
|
| 22 | - |
|
| 23 | ------------------------------------------------------------------------------
|
|
| 24 | --- Printing the results in DocBook format
|
|
| 25 | - |
|
| 26 | -ppDocBook :: a
|
|
| 27 | -ppDocBook = error "not working"
|
|
| 28 | - |
|
| 29 | -{-
|
|
| 30 | -ppDocBook :: FilePath -> [(Module, Interface)] -> String
|
|
| 31 | -ppDocBook odir mods = render (ppIfaces mods)
|
|
| 32 | - |
|
| 33 | -ppIfaces mods
|
|
| 34 | - = text "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" ["
|
|
| 35 | - $$ text "]>"
|
|
| 36 | - $$ text "<book>"
|
|
| 37 | - $$ text "<bookinfo>"
|
|
| 38 | - $$ text "<author><othername>HaskellDoc version 0.0</othername></author>"
|
|
| 39 | - $$ text "</bookinfo>"
|
|
| 40 | - $$ text "<article>"
|
|
| 41 | - $$ vcat (map do_mod mods)
|
|
| 42 | - $$ text "</article></book>"
|
|
| 43 | - where
|
|
| 44 | - do_mod (Module mod, iface)
|
|
| 45 | - = text "<sect1 id=\"sec-" <> text mod <> text "\">"
|
|
| 46 | - $$ text "<title><literal>"
|
|
| 47 | - <> text mod
|
|
| 48 | - <> text "</literal></title>"
|
|
| 49 | - $$ text "<indexterm><primary><literal>"
|
|
| 50 | - <> text mod
|
|
| 51 | - <> text "</literal></primary></indexterm>"
|
|
| 52 | - $$ text "<variablelist>"
|
|
| 53 | - $$ vcat (map (do_export mod) (eltsFM (iface_decls iface)))
|
|
| 54 | - $$ text "</variablelist>"
|
|
| 55 | - $$ text "</sect1>"
|
|
| 56 | - |
|
| 57 | - do_export mod decl | (nm:_) <- declBinders decl
|
|
| 58 | - = text "<varlistentry id=" <> ppLinkId mod nm <> char '>'
|
|
| 59 | - $$ text "<term><literal>"
|
|
| 60 | - <> do_decl decl
|
|
| 61 | - <> text "</literal></term>"
|
|
| 62 | - $$ text "<listitem>"
|
|
| 63 | - $$ text "<para>"
|
|
| 64 | - $$ text "</para>"
|
|
| 65 | - $$ text "</listitem>"
|
|
| 66 | - $$ text "</varlistentry>"
|
|
| 67 | - do_export _ _ = empty
|
|
| 68 | - |
|
| 69 | - do_decl (HsTypeSig _ [nm] ty _)
|
|
| 70 | - = ppHsName nm <> text " :: " <> ppHsType ty
|
|
| 71 | - do_decl (HsTypeDecl _ nm args ty _)
|
|
| 72 | - = hsep ([text "type", ppHsName nm ]
|
|
| 73 | - ++ map ppHsName args
|
|
| 74 | - ++ [equals, ppHsType ty])
|
|
| 75 | - do_decl (HsNewTypeDecl loc ctx nm args con drv _)
|
|
| 76 | - = hsep ([text "data", ppHsName nm] -- data, not newtype
|
|
| 77 | - ++ map ppHsName args
|
|
| 78 | - ) <+> equals <+> ppHsConstr con -- ToDo: derivings
|
|
| 79 | - do_decl (HsDataDecl loc ctx nm args cons drv _)
|
|
| 80 | - = hsep ([text "data", {-ToDo: context-}ppHsName nm]
|
|
| 81 | - ++ map ppHsName args)
|
|
| 82 | - <+> vcat (zipWith (<+>) (equals : repeat (char '|'))
|
|
| 83 | - (map ppHsConstr cons))
|
|
| 84 | - do_decl (HsClassDecl loc ty fds decl _)
|
|
| 85 | - = hsep [text "class", ppHsType ty]
|
|
| 86 | - do_decl decl
|
|
| 87 | - = empty
|
|
| 88 | - |
|
| 89 | -ppHsConstr :: HsConDecl -> Doc
|
|
| 90 | -ppHsConstr (HsRecDecl pos name tvs ctxt fieldList maybe_doc) =
|
|
| 91 | - ppHsName name
|
|
| 92 | - <> (braces . hsep . punctuate comma . map ppField $ fieldList)
|
|
| 93 | -ppHsConstr (HsConDecl pos name tvs ctxt typeList maybe_doc) =
|
|
| 94 | - hsep (ppHsName name : map ppHsBangType typeList)
|
|
| 95 | - |
|
| 96 | -ppField (HsFieldDecl ns ty doc)
|
|
| 97 | - = hsep (punctuate comma (map ppHsName ns) ++
|
|
| 98 | - [text "::", ppHsBangType ty])
|
|
| 99 | - |
|
| 100 | -ppHsBangType :: HsBangType -> Doc
|
|
| 101 | -ppHsBangType (HsBangedTy ty) = char '!' <> ppHsType ty
|
|
| 102 | -ppHsBangType (HsUnBangedTy ty) = ppHsType ty
|
|
| 103 | - |
|
| 104 | -ppHsContext :: HsContext -> Doc
|
|
| 105 | -ppHsContext [] = empty
|
|
| 106 | -ppHsContext context = parenList (map (\ (a,b) -> ppHsQName a <+>
|
|
| 107 | - hsep (map ppHsAType b)) context)
|
|
| 108 | - |
|
| 109 | -ppHsType :: HsType -> Doc
|
|
| 110 | -ppHsType (HsForAllType _ Nothing context htype) =
|
|
| 111 | - hsep [ ppHsContext context, text "=>", ppHsType htype]
|
|
| 112 | -ppHsType (HsForAllType fvf (Just tvs) [] htype) =
|
|
| 113 | - hsep (text "forall" : map ppHsName tvs ++ pprHsForAllSeparator fvf :
|
|
| 114 | - [ppHsType htype])
|
|
| 115 | -ppHsType (HsForAllType fvf (Just tvs) context htype) =
|
|
| 116 | - hsep (text "forall" : map ppHsName tvs ++ pprHsForAllSeparator fvf :
|
|
| 117 | - ppHsContext context : text "=>" : [ppHsType htype])
|
|
| 118 | -ppHsType (HsTyFun a b) = fsep [ppHsBType a, text "->", ppHsType b]
|
|
| 119 | -ppHsType (HsTyIP n t) = fsep [(char '?' <> ppHsName n), text "::", ppHsType t]
|
|
| 120 | -ppHsType t = ppHsBType t
|
|
| 121 | - |
|
| 122 | -ppHsForAllSeparator :: ForallVisFlag -> Doc
|
|
| 123 | -ppHsForAllSeparator ForallVis = text "->"
|
|
| 124 | -ppHsForAllSeparator ForallInvis = text "."
|
|
| 125 | - |
|
| 126 | -ppHsBType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b )
|
|
| 127 | - = brackets $ ppHsType b
|
|
| 128 | -ppHsBType (HsTyApp a b) = fsep [ppHsBType a, ppHsAType b]
|
|
| 129 | -ppHsBType t = ppHsAType t
|
|
| 130 | - |
|
| 131 | -ppHsAType :: HsType -> Doc
|
|
| 132 | -ppHsAType (HsTyTuple True l) = parenList . map ppHsType $ l
|
|
| 133 | -ppHsAType (HsTyTuple False l) = ubxParenList . map ppHsType $ l
|
|
| 134 | --- special case
|
|
| 135 | -ppHsAType (HsTyApp (HsTyCon (Qual (Module "Prelude") (HsTyClsName (HsSpecial "[]")))) b )
|
|
| 136 | - = brackets $ ppHsType b
|
|
| 137 | -ppHsAType (HsTyVar name) = ppHsName name
|
|
| 138 | -ppHsAType (HsTyCon name) = ppHsQName name
|
|
| 139 | -ppHsAType t = parens $ ppHsType t
|
|
| 140 | - |
|
| 141 | -ppHsQName :: HsQName -> Doc
|
|
| 142 | -ppHsQName (UnQual str) = ppHsName str
|
|
| 143 | -ppHsQName n@(Qual (Module mod) str)
|
|
| 144 | - | n == unit_con_name = ppHsName str
|
|
| 145 | - | isSpecial str = ppHsName str
|
|
| 146 | - | otherwise
|
|
| 147 | - = text "<link linkend=" <> ppLinkId mod str <> char '>'
|
|
| 148 | - <> ppHsName str
|
|
| 149 | - <> text "</link>"
|
|
| 150 | - |
|
| 151 | -isSpecial (HsTyClsName id) | HsSpecial _ <- id = True
|
|
| 152 | -isSpecial (HsVarName id) | HsSpecial _ <- id = True
|
|
| 153 | -isSpecial _ = False
|
|
| 154 | - |
|
| 155 | -ppHsName :: HsName -> Doc
|
|
| 156 | -ppHsName (HsTyClsName id) = ppHsIdentifier id
|
|
| 157 | -ppHsName (HsVarName id) = ppHsIdentifier id
|
|
| 158 | - |
|
| 159 | -ppHsIdentifier :: HsIdentifier -> Doc
|
|
| 160 | -ppHsIdentifier (HsIdent str) = text str
|
|
| 161 | -ppHsIdentifier (HsSymbol str) = text str
|
|
| 162 | -ppHsIdentifier (HsSpecial str) = text str
|
|
| 163 | - |
|
| 164 | -ppLinkId :: String -> HsName -> Doc
|
|
| 165 | -ppLinkId mod str
|
|
| 166 | - = hcat [char '\"', text mod, char '.', ppHsName str, char '\"']
|
|
| 167 | - |
|
| 168 | --- -----------------------------------------------------------------------------
|
|
| 169 | --- * Misc
|
|
| 170 | - |
|
| 171 | -parenList :: [Doc] -> Doc
|
|
| 172 | -parenList = parens . fsep . punctuate comma
|
|
| 173 | - |
|
| 174 | -ubxParenList :: [Doc] -> Doc
|
|
| 175 | -ubxParenList = ubxparens . fsep . punctuate comma
|
|
| 176 | - |
|
| 177 | -ubxparens p = text "(#" <> p <> text "#)"
|
|
| 178 | --} |