{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Backends.Hoogle
-- Copyright   :  (c) Neil Mitchell 2006-2008
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- Write out Hoogle compatible documentation
-- http://www.haskell.org/hoogle/
-----------------------------------------------------------------------------
module Haddock.Backends.Hoogle (
    ppHoogle
  ) where

import BasicTypes ( OverlapFlag(..), OverlapMode(..), SourceText(..)
                  , PromotionFlag(..), TopLevelFlag(..) )
import InstEnv (ClsInst(..))
import Documentation.Haddock.Markup
import Haddock.GhcUtils
import Haddock.Types hiding (Version)
import Haddock.Utils hiding (out)

import GHC
import Outputable

import Data.Char
import Data.List (isPrefixOf, intercalate)
import Data.Maybe
import Data.Version

import System.Directory
import System.FilePath

prefix :: [String]
prefix :: [String]
prefix = [String
"-- Hoogle documentation, generated by Haddock"
         ,String
"-- See Hoogle, http://www.haskell.org/hoogle/"
         ,String
""]


ppHoogle :: DynFlags -> String -> Version -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()
ppHoogle :: DynFlags
-> String
-> Version
-> String
-> Maybe (Doc RdrName)
-> [Interface]
-> String
-> IO ()
ppHoogle DynFlags
dflags String
package Version
version String
synopsis Maybe (Doc RdrName)
prologue [Interface]
ifaces String
odir = do
    let -- Since Hoogle is line based, we want to avoid breaking long lines.
        dflags' :: DynFlags
dflags' = DynFlags
dflags{ pprCols :: Int
pprCols = Int
forall a. Bounded a => a
maxBound }
        filename :: String
filename = String
package String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".txt"
        contents :: [String]
contents = [String]
prefix [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                   DynFlags -> String -> Maybe (Doc RdrName) -> [String]
forall o.
Outputable o =>
DynFlags -> String -> Maybe (Doc o) -> [String]
docWith DynFlags
dflags' (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
synopsis) Maybe (Doc RdrName)
prologue [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                   [String
"@package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
package] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                   [String
"@version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version
                   | Bool -> Bool
not ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Version -> [Int]
versionBranch Version
version)) ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                   [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [DynFlags -> Interface -> [String]
ppModule DynFlags
dflags' Interface
i | Interface
i <- [Interface]
ifaces, DocOption
OptHide DocOption -> [DocOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Interface -> [DocOption]
ifaceOptions Interface
i]
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
odir
    String -> String -> IO ()
writeUtf8File (String
odir String -> String -> String
</> String
filename) ([String] -> String
unlines [String]
contents)

ppModule :: DynFlags -> Interface -> [String]
ppModule :: DynFlags -> Interface -> [String]
ppModule DynFlags
dflags Interface
iface =
  String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: DynFlags -> Documentation Name -> [String]
forall o. Outputable o => DynFlags -> Documentation o -> [String]
ppDocumentation DynFlags
dflags (Interface -> Documentation Name
ifaceDoc Interface
iface) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  [String
"module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Module -> String
moduleString (Interface -> Module
ifaceMod Interface
iface)] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  (ExportItem GhcRn -> [String]) -> [ExportItem GhcRn] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags -> ExportItem GhcRn -> [String]
ppExport DynFlags
dflags) (Interface -> [ExportItem GhcRn]
ifaceExportItems Interface
iface) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  (ClsInst -> [String]) -> [ClsInst] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags -> ClsInst -> [String]
ppInstance DynFlags
dflags) (Interface -> [ClsInst]
ifaceInstances Interface
iface)


---------------------------------------------------------------------
-- Utility functions

dropHsDocTy :: HsType a -> HsType a
dropHsDocTy :: HsType a -> HsType a
dropHsDocTy = HsType a -> HsType a
forall pass. HsType pass -> HsType pass
f
    where
        g :: GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g (L SrcSpan
src HsType pass
x) = SrcSpan -> HsType pass -> GenLocated SrcSpan (HsType pass)
forall l e. l -> e -> GenLocated l e
L SrcSpan
src (HsType pass -> HsType pass
f HsType pass
x)
        f :: HsType pass -> HsType pass
f (HsForAllTy XForAllTy pass
x ForallVisFlag
fvf [LHsTyVarBndr pass]
a GenLocated SrcSpan (HsType pass)
e) = XForAllTy pass
-> ForallVisFlag
-> [LHsTyVarBndr pass]
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XForAllTy pass
-> ForallVisFlag
-> [LHsTyVarBndr pass]
-> LHsType pass
-> HsType pass
HsForAllTy XForAllTy pass
x ForallVisFlag
fvf [LHsTyVarBndr pass]
a (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
e)
        f (HsQualTy XQualTy pass
x LHsContext pass
a GenLocated SrcSpan (HsType pass)
e) = XQualTy pass
-> LHsContext pass
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy XQualTy pass
x LHsContext pass
a (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
e)
        f (HsBangTy XBangTy pass
x HsSrcBang
a GenLocated SrcSpan (HsType pass)
b) = XBangTy pass
-> HsSrcBang -> GenLocated SrcSpan (HsType pass) -> HsType pass
forall pass.
XBangTy pass -> HsSrcBang -> LHsType pass -> HsType pass
HsBangTy XBangTy pass
x HsSrcBang
a (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
b)
        f (HsAppTy XAppTy pass
x GenLocated SrcSpan (HsType pass)
a GenLocated SrcSpan (HsType pass)
b) = XAppTy pass
-> GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a) (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
b)
        f (HsAppKindTy XAppKindTy pass
x GenLocated SrcSpan (HsType pass)
a GenLocated SrcSpan (HsType pass)
b) = XAppKindTy pass
-> GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a) (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
b)
        f (HsFunTy XFunTy pass
x GenLocated SrcSpan (HsType pass)
a GenLocated SrcSpan (HsType pass)
b) = XFunTy pass
-> GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a) (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
b)
        f (HsListTy XListTy pass
x GenLocated SrcSpan (HsType pass)
a) = XListTy pass -> GenLocated SrcSpan (HsType pass) -> HsType pass
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a)
        f (HsTupleTy XTupleTy pass
x HsTupleSort
a [GenLocated SrcSpan (HsType pass)]
b) = XTupleTy pass
-> HsTupleSort -> [GenLocated SrcSpan (HsType pass)] -> HsType pass
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy pass
x HsTupleSort
a ((GenLocated SrcSpan (HsType pass)
 -> GenLocated SrcSpan (HsType pass))
-> [GenLocated SrcSpan (HsType pass)]
-> [GenLocated SrcSpan (HsType pass)]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g [GenLocated SrcSpan (HsType pass)]
b)
        f (HsOpTy XOpTy pass
x GenLocated SrcSpan (HsType pass)
a Located (IdP pass)
b GenLocated SrcSpan (HsType pass)
c) = XOpTy pass
-> GenLocated SrcSpan (HsType pass)
-> Located (IdP pass)
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XOpTy pass
-> LHsType pass
-> Located (IdP pass)
-> LHsType pass
-> HsType pass
HsOpTy XOpTy pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a) Located (IdP pass)
b (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
c)
        f (HsParTy XParTy pass
x GenLocated SrcSpan (HsType pass)
a) = XParTy pass -> GenLocated SrcSpan (HsType pass) -> HsType pass
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a)
        f (HsKindSig XKindSig pass
x GenLocated SrcSpan (HsType pass)
a GenLocated SrcSpan (HsType pass)
b) = XKindSig pass
-> GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
-> HsType pass
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig XKindSig pass
x (GenLocated SrcSpan (HsType pass)
-> GenLocated SrcSpan (HsType pass)
g GenLocated SrcSpan (HsType pass)
a) GenLocated SrcSpan (HsType pass)
b
        f (HsDocTy XDocTy pass
_ GenLocated SrcSpan (HsType pass)
a LHsDocString
_) = HsType pass -> HsType pass
f (HsType pass -> HsType pass) -> HsType pass -> HsType pass
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan (HsType pass)
-> SrcSpanLess (GenLocated SrcSpan (HsType pass))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc GenLocated SrcSpan (HsType pass)
a
        f HsType pass
x = HsType pass
x

outHsType :: (OutputableBndrId p)
          => DynFlags -> HsType (GhcPass p) -> String
outHsType :: DynFlags -> HsType (GhcPass p) -> String
outHsType DynFlags
dflags = DynFlags -> HsType (GhcPass p) -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags (HsType (GhcPass p) -> String)
-> (HsType (GhcPass p) -> HsType (GhcPass p))
-> HsType (GhcPass p)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType (GhcPass p) -> HsType (GhcPass p)
forall a. (XParTy a ~ NoExtField) => HsType a -> HsType a
reparenType (HsType (GhcPass p) -> HsType (GhcPass p))
-> (HsType (GhcPass p) -> HsType (GhcPass p))
-> HsType (GhcPass p)
-> HsType (GhcPass p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsType (GhcPass p) -> HsType (GhcPass p)
forall pass. HsType pass -> HsType pass
dropHsDocTy


dropComment :: String -> String
dropComment :: String -> String
dropComment (Char
' ':Char
'-':Char
'-':Char
' ':String
_) = []
dropComment (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
dropComment String
xs
dropComment [] = []


outWith :: Outputable a => (SDoc -> String) -> a -> [Char]
outWith :: (SDoc -> String) -> a -> String
outWith SDoc -> String
p = String -> String
f (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (a -> [String]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace) ([String] -> [String]) -> (a -> [String]) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> (a -> String) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
p (SDoc -> String) -> (a -> SDoc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
ppr
    where
        f :: String -> String
f String
xs | String
" <document comment>" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs = String -> String
f (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
19 String
xs
        f (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
xs
        f [] = []

out :: Outputable a => DynFlags -> a -> String
out :: DynFlags -> a -> String
out DynFlags
dflags = (SDoc -> String) -> a -> String
forall a. Outputable a => (SDoc -> String) -> a -> String
outWith ((SDoc -> String) -> a -> String)
-> (SDoc -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ DynFlags -> SDoc -> String
showSDocUnqual DynFlags
dflags

operator :: String -> String
operator :: String -> String
operator (Char
x:String
xs) | Bool -> Bool
not (Char -> Bool
isAlphaNum Char
x) Bool -> Bool -> Bool
&& Char
x Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
"_' ([{" = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
operator String
x = String
x

commaSeparate :: Outputable a => DynFlags -> [a] -> String
commaSeparate :: DynFlags -> [a] -> String
commaSeparate DynFlags
dflags = DynFlags -> SDoc -> String
showSDocUnqual DynFlags
dflags (SDoc -> String) -> ([a] -> SDoc) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP

---------------------------------------------------------------------
-- How to print each export

ppExport :: DynFlags -> ExportItem GhcRn -> [String]
ppExport :: DynFlags -> ExportItem GhcRn -> [String]
ppExport DynFlags
dflags ExportDecl { expItemDecl :: forall name. ExportItem name -> LHsDecl name
expItemDecl    = L SrcSpan
_ HsDecl GhcRn
decl
                           , expItemPats :: forall name.
ExportItem name -> [(HsDecl name, DocForDecl (IdP name))]
expItemPats    = [(HsDecl GhcRn, DocForDecl (IdP GhcRn))]
bundledPats
                           , expItemMbDoc :: forall name. ExportItem name -> DocForDecl (IdP name)
expItemMbDoc   = DocForDecl (IdP GhcRn)
mbDoc
                           , expItemSubDocs :: forall name. ExportItem name -> [(IdP name, DocForDecl (IdP name))]
expItemSubDocs = [(IdP GhcRn, DocForDecl (IdP GhcRn))]
subdocs
                           , expItemFixities :: forall name. ExportItem name -> [(IdP name, Fixity)]
expItemFixities = [(IdP GhcRn, Fixity)]
fixities
                           } = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ DynFlags -> Documentation Name -> [String]
forall o. Outputable o => DynFlags -> Documentation o -> [String]
ppDocumentation DynFlags
dflags Documentation Name
dc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ HsDecl GhcRn -> [String]
f HsDecl GhcRn
d
                                      | (HsDecl GhcRn
d, (Documentation Name
dc, FnArgsDoc Name
_)) <- (HsDecl GhcRn
decl, DocForDecl (IdP GhcRn)
(Documentation Name, FnArgsDoc Name)
mbDoc) (HsDecl GhcRn, (Documentation Name, FnArgsDoc Name))
-> [(HsDecl GhcRn, (Documentation Name, FnArgsDoc Name))]
-> [(HsDecl GhcRn, (Documentation Name, FnArgsDoc Name))]
forall a. a -> [a] -> [a]
: [(HsDecl GhcRn, DocForDecl (IdP GhcRn))]
[(HsDecl GhcRn, (Documentation Name, FnArgsDoc Name))]
bundledPats
                                      ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                               [String]
ppFixities
    where
        f :: HsDecl GhcRn -> [String]
f (TyClD XTyClD GhcRn
_ d :: TyClDecl GhcRn
d@DataDecl{})  = DynFlags
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppData DynFlags
dflags TyClDecl GhcRn
d [(IdP GhcRn, DocForDecl (IdP GhcRn))]
[(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
        f (TyClD XTyClD GhcRn
_ d :: TyClDecl GhcRn
d@SynDecl{})   = DynFlags -> TyClDecl GhcRn -> [String]
ppSynonym DynFlags
dflags TyClDecl GhcRn
d
        f (TyClD XTyClD GhcRn
_ d :: TyClDecl GhcRn
d@ClassDecl{}) = DynFlags
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppClass DynFlags
dflags TyClDecl GhcRn
d [(IdP GhcRn, DocForDecl (IdP GhcRn))]
[(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
        f (TyClD XTyClD GhcRn
_ (FamDecl XFamDecl GhcRn
_ FamilyDecl GhcRn
d)) = DynFlags -> FamilyDecl GhcRn -> [String]
ppFam DynFlags
dflags FamilyDecl GhcRn
d
        f (ForD XForD GhcRn
_ (ForeignImport XForeignImport GhcRn
_ Located (IdP GhcRn)
name LHsSigType GhcRn
typ ForeignImport
_)) = [DynFlags -> [Located Name] -> LHsType GhcRn -> String
pp_sig DynFlags
dflags [Located (IdP GhcRn)
Located Name
name] (LHsSigType GhcRn -> LHsType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType LHsSigType GhcRn
typ)]
        f (ForD XForD GhcRn
_ (ForeignExport XForeignExport GhcRn
_ Located (IdP GhcRn)
name LHsSigType GhcRn
typ ForeignExport
_)) = [DynFlags -> [Located Name] -> LHsType GhcRn -> String
pp_sig DynFlags
dflags [Located (IdP GhcRn)
Located Name
name] (LHsSigType GhcRn -> LHsType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType LHsSigType GhcRn
typ)]
        f (SigD XSigD GhcRn
_ Sig GhcRn
sig) = DynFlags -> Sig GhcRn -> [String]
ppSig DynFlags
dflags Sig GhcRn
sig
        f HsDecl GhcRn
_ = []

        ppFixities :: [String]
ppFixities = ((Name, Fixity) -> [String]) -> [(Name, Fixity)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags -> (Name, Fixity) -> [String]
ppFixity DynFlags
dflags) [(IdP GhcRn, Fixity)]
[(Name, Fixity)]
fixities
ppExport DynFlags
_ ExportItem GhcRn
_ = []

ppSigWithDoc :: DynFlags -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppSigWithDoc :: DynFlags
-> Sig GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppSigWithDoc DynFlags
dflags Sig GhcRn
sig [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs = case Sig GhcRn
sig of
    TypeSig XTypeSig GhcRn
_ [Located (IdP GhcRn)]
names LHsSigWcType GhcRn
t -> (Located Name -> [String]) -> [Located Name] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> LHsType GhcRn -> Located Name -> [String]
mkDocSig String
"" (LHsSigWcType GhcRn -> LHsType GhcRn
forall pass. LHsSigWcType pass -> LHsType pass
hsSigWcType LHsSigWcType GhcRn
t)) [Located (IdP GhcRn)]
[Located Name]
names
    PatSynSig XPatSynSig GhcRn
_ [Located (IdP GhcRn)]
names LHsSigType GhcRn
t -> (Located Name -> [String]) -> [Located Name] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String -> LHsType GhcRn -> Located Name -> [String]
mkDocSig String
"pattern " (LHsSigType GhcRn -> LHsType GhcRn
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
hsSigType LHsSigType GhcRn
t)) [Located (IdP GhcRn)]
[Located Name]
names
    Sig GhcRn
_ -> []
  where
    mkDocSig :: String -> LHsType GhcRn -> Located Name -> [String]
mkDocSig String
leader LHsType GhcRn
typ Located Name
n = DynFlags
-> Located Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdoc DynFlags
dflags Located Name
n [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
                                     [String
leader String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> [Located Name] -> LHsType GhcRn -> String
pp_sig DynFlags
dflags [Located Name
n] LHsType GhcRn
typ]

ppSig :: DynFlags -> Sig GhcRn -> [String]
ppSig :: DynFlags -> Sig GhcRn -> [String]
ppSig DynFlags
dflags Sig GhcRn
x  = DynFlags
-> Sig GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppSigWithDoc DynFlags
dflags Sig GhcRn
x []

pp_sig :: DynFlags -> [Located Name] -> LHsType GhcRn -> String
pp_sig :: DynFlags -> [Located Name] -> LHsType GhcRn -> String
pp_sig DynFlags
dflags [Located Name]
names (L SrcSpan
_ HsType GhcRn
typ)  =
    String -> String
operator String
prettyNames String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> HsType GhcRn -> String
forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> HsType (GhcPass p) -> String
outHsType DynFlags
dflags HsType GhcRn
typ
    where
      prettyNames :: String
prettyNames = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Located Name -> String) -> [Located Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags -> Located Name -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags) [Located Name]
names

-- note: does not yet output documentation for class methods
ppClass :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppClass :: DynFlags
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppClass DynFlags
dflags TyClDecl GhcRn
decl [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs =
  (DynFlags -> TyClDecl GhcRn -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags TyClDecl GhcRn
decl{tcdSigs :: [LSig GhcRn]
tcdSigs=[], tcdATs :: [LFamilyDecl GhcRn]
tcdATs=[], tcdATDefs :: [LTyFamDefltDecl GhcRn]
tcdATDefs=[], tcdMeths :: LHsBinds GhcRn
tcdMeths=LHsBinds GhcRn
forall idL idR. LHsBindsLR idL idR
emptyLHsBinds}
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ppTyFams) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:  [String]
ppMethods
    where

        ppMethods :: [String]
ppMethods = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([LSig GhcRn] -> [[String]]) -> [LSig GhcRn] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LSig GhcRn -> [String]) -> [LSig GhcRn] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Sig GhcRn -> [String]
ppSig' (Sig GhcRn -> [String])
-> (LSig GhcRn -> Sig GhcRn) -> LSig GhcRn -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig GhcRn -> Sig GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LSig GhcRn -> Sig GhcRn)
-> (LSig GhcRn -> LSig GhcRn) -> LSig GhcRn -> Sig GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LSig GhcRn -> LSig GhcRn
add_ctxt) ([LSig GhcRn] -> [String]) -> [LSig GhcRn] -> [String]
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcRn -> [LSig GhcRn]
forall pass. TyClDecl pass -> [LSig pass]
tcdSigs TyClDecl GhcRn
decl
        ppSig' :: Sig GhcRn -> [String]
ppSig' = (Sig GhcRn
 -> [(Name, (Documentation Name, FnArgsDoc Name))] -> [String])
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Sig GhcRn
-> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DynFlags
-> Sig GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppSigWithDoc DynFlags
dflags) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs

        add_ctxt :: LSig GhcRn -> LSig GhcRn
add_ctxt = Name -> LHsQTyVars GhcRn -> LSig GhcRn -> LSig GhcRn
addClassContext (TyClDecl GhcRn -> IdP GhcRn
forall (p :: Pass). TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl GhcRn
decl) (TyClDecl GhcRn -> LHsQTyVars GhcRn
forall pass. TyClDecl pass -> LHsQTyVars pass
tyClDeclTyVars TyClDecl GhcRn
decl)

        ppTyFams :: String
ppTyFams
            | [LFamilyDecl GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LFamilyDecl GhcRn] -> Bool) -> [LFamilyDecl GhcRn] -> Bool
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcRn -> [LFamilyDecl GhcRn]
forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs TyClDecl GhcRn
decl = String
""
            | Bool
otherwise = (String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> ([SDoc] -> String) -> [SDoc] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> SDoc -> String
showSDocUnqual DynFlags
dflags (SDoc -> String) -> ([SDoc] -> SDoc) -> [SDoc] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
whereWrapper ([SDoc] -> String) -> [SDoc] -> String
forall a b. (a -> b) -> a -> b
$ [[SDoc]] -> [SDoc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ (LFamilyDecl GhcRn -> SDoc) -> [LFamilyDecl GhcRn] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LFamilyDecl GhcRn -> SDoc
pprTyFam (TyClDecl GhcRn -> [LFamilyDecl GhcRn]
forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs TyClDecl GhcRn
decl)
                , (LTyFamDefltDecl GhcRn -> SDoc)
-> [LTyFamDefltDecl GhcRn] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TopLevelFlag -> TyFamInstDecl GhcRn -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
TopLevelFlag -> TyFamInstDecl (GhcPass p) -> SDoc
pprTyFamInstDecl TopLevelFlag
NotTopLevel (TyFamInstDecl GhcRn -> SDoc)
-> (LTyFamDefltDecl GhcRn -> TyFamInstDecl GhcRn)
-> LTyFamDefltDecl GhcRn
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTyFamDefltDecl GhcRn -> TyFamInstDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (TyClDecl GhcRn -> [LTyFamDefltDecl GhcRn]
forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs TyClDecl GhcRn
decl)
                ]

        pprTyFam :: LFamilyDecl GhcRn -> SDoc
        pprTyFam :: LFamilyDecl GhcRn -> SDoc
pprTyFam (L SrcSpan
_ FamilyDecl GhcRn
at) = [SDoc] -> SDoc
vcat' ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (String -> SDoc) -> [String] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> SDoc
text ([String] -> [SDoc]) -> [String] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
            DynFlags
-> Located Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdoc DynFlags
dflags (FamilyDecl GhcRn -> Located (IdP GhcRn)
forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName FamilyDecl GhcRn
at) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (DynFlags -> FamilyDecl GhcRn -> [String]
ppFam DynFlags
dflags FamilyDecl GhcRn
at)

        whereWrapper :: [SDoc] -> SDoc
whereWrapper [SDoc]
elems = [SDoc] -> SDoc
vcat'
            [ String -> SDoc
text String
"where" SDoc -> SDoc -> SDoc
<+> SDoc
lbrace
            , Int -> SDoc -> SDoc
nest Int
4 (SDoc -> SDoc) -> ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> ([SDoc] -> [SDoc]) -> [SDoc] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> SDoc -> SDoc
Outputable.<> SDoc
semi) ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc]
elems
            , SDoc
rbrace
            ]

ppFam :: DynFlags -> FamilyDecl GhcRn -> [String]
ppFam :: DynFlags -> FamilyDecl GhcRn -> [String]
ppFam DynFlags
dflags decl :: FamilyDecl GhcRn
decl@(FamilyDecl { fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo GhcRn
info })
  = [DynFlags -> FamilyDecl GhcRn -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags FamilyDecl GhcRn
decl']
  where
    decl' :: FamilyDecl GhcRn
decl' = case FamilyInfo GhcRn
info of
              -- We don't need to print out a closed type family's equations
              -- for Hoogle, so pretend it doesn't have any.
              ClosedTypeFamily{} -> FamilyDecl GhcRn
decl { fdInfo :: FamilyInfo GhcRn
fdInfo = FamilyInfo GhcRn
forall pass. FamilyInfo pass
OpenTypeFamily }
              FamilyInfo GhcRn
_                  -> FamilyDecl GhcRn
decl
ppFam DynFlags
_ (XFamilyDecl XXFamilyDecl GhcRn
nec) = NoExtCon -> [String]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXFamilyDecl GhcRn
nec

ppInstance :: DynFlags -> ClsInst -> [String]
ppInstance :: DynFlags -> ClsInst -> [String]
ppInstance DynFlags
dflags ClsInst
x =
  [String -> String
dropComment (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (SDoc -> String) -> ClsInst -> String
forall a. Outputable a => (SDoc -> String) -> a -> String
outWith (DynFlags -> PrintUnqualified -> SDoc -> String
showSDocForUser DynFlags
dflags PrintUnqualified
alwaysQualify) ClsInst
cls]
  where
    -- As per #168, we don't want safety information about the class
    -- in Hoogle output. The easiest way to achieve this is to set the
    -- safety information to a state where the Outputable instance
    -- produces no output which means no overlap and unsafe (or [safe]
    -- is generated).
    cls :: ClsInst
cls = ClsInst
x { is_flag :: OverlapFlag
is_flag = OverlapFlag :: OverlapMode -> Bool -> OverlapFlag
OverlapFlag { overlapMode :: OverlapMode
overlapMode = SourceText -> OverlapMode
NoOverlap SourceText
NoSourceText
                                    , isSafeOverlap :: Bool
isSafeOverlap = Bool
False } }

ppSynonym :: DynFlags -> TyClDecl GhcRn -> [String]
ppSynonym :: DynFlags -> TyClDecl GhcRn -> [String]
ppSynonym DynFlags
dflags TyClDecl GhcRn
x = [DynFlags -> TyClDecl GhcRn -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags TyClDecl GhcRn
x]

ppData :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppData :: DynFlags
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppData DynFlags
dflags decl :: TyClDecl GhcRn
decl@(DataDecl { tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcRn
defn }) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
    = TyClDecl GhcRn -> String
showData TyClDecl GhcRn
decl{ tcdDataDefn :: HsDataDefn GhcRn
tcdDataDefn = HsDataDefn GhcRn
defn { dd_cons :: [LConDecl GhcRn]
dd_cons=[],dd_derivs :: HsDeriving GhcRn
dd_derivs=SrcSpanLess (HsDeriving GhcRn) -> HsDeriving GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc [] }} String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
      (LConDecl GhcRn -> [String]) -> [LConDecl GhcRn] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> ConDecl GhcRn
-> [String]
ppCtor DynFlags
dflags TyClDecl GhcRn
decl [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (ConDecl GhcRn -> [String])
-> (LConDecl GhcRn -> ConDecl GhcRn) -> LConDecl GhcRn -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LConDecl GhcRn -> ConDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (HsDataDefn GhcRn -> [LConDecl GhcRn]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcRn
defn)
    where

        -- GHC gives out "data Bar =", we want to delete the equals.
        -- There's no need to worry about parenthesizing infix data type names,
        -- since this Outputable instance for TyClDecl gets this right already.
        showData :: TyClDecl GhcRn -> String
showData TyClDecl GhcRn
d = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ if [String] -> String
forall a. [a] -> a
last [String]
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"=" then [String] -> [String]
forall a. [a] -> [a]
init [String]
xs else [String]
xs
            where
                xs :: [String]
xs = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ DynFlags -> TyClDecl GhcRn -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags TyClDecl GhcRn
d
ppData DynFlags
_ TyClDecl GhcRn
_ [(Name, (Documentation Name, FnArgsDoc Name))]
_ = String -> [String]
forall a. String -> a
panic String
"ppData"

-- | for constructors, and named-fields...
lookupCon :: DynFlags -> [(Name, DocForDecl Name)] -> Located Name -> [String]
lookupCon :: DynFlags
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Located Name
-> [String]
lookupCon DynFlags
dflags [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (L SrcSpan
_ Name
name) = case Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Maybe (Documentation Name, FnArgsDoc Name)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
name [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs of
  Just (Documentation Name
d, FnArgsDoc Name
_) -> DynFlags -> Documentation Name -> [String]
forall o. Outputable o => DynFlags -> Documentation o -> [String]
ppDocumentation DynFlags
dflags Documentation Name
d
  Maybe (Documentation Name, FnArgsDoc Name)
_ -> []

ppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]
ppCtor :: DynFlags
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> ConDecl GhcRn
-> [String]
ppCtor DynFlags
dflags TyClDecl GhcRn
dat [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs con :: ConDecl GhcRn
con@ConDeclH98 {}
  -- AZ:TODO get rid of the concatMap
   = (Located Name -> [String]) -> [Located Name] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Located Name
-> [String]
lookupCon DynFlags
dflags [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs) [ConDecl GhcRn -> Located (IdP GhcRn)
forall pass. ConDecl pass -> Located (IdP pass)
con_name ConDecl GhcRn
con] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ HsConDetails
  (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
-> [String]
f (ConDecl GhcRn
-> HsConDetails
     (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
forall pass. ConDecl pass -> HsConDeclDetails pass
getConArgs ConDecl GhcRn
con)
    where
        f :: HsConDetails
  (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
-> [String]
f (PrefixCon [LHsType GhcRn]
args) = [String -> [LHsType GhcRn] -> String
typeSig String
name ([LHsType GhcRn] -> String) -> [LHsType GhcRn] -> String
forall a b. (a -> b) -> a -> b
$ [LHsType GhcRn]
args [LHsType GhcRn] -> [LHsType GhcRn] -> [LHsType GhcRn]
forall a. [a] -> [a] -> [a]
++ [LHsType GhcRn
resType]]
        f (InfixCon LHsType GhcRn
a1 LHsType GhcRn
a2) = HsConDetails
  (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
-> [String]
f (HsConDetails
   (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
 -> [String])
-> HsConDetails
     (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
-> [String]
forall a b. (a -> b) -> a -> b
$ [LHsType GhcRn]
-> HsConDetails
     (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon [LHsType GhcRn
a1,LHsType GhcRn
a2]
        f (RecCon (L SrcSpan
_ [LConDeclField GhcRn]
recs)) = HsConDetails
  (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
-> [String]
f ([LHsType GhcRn]
-> HsConDetails
     (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
forall arg rec. [arg] -> HsConDetails arg rec
PrefixCon ([LHsType GhcRn]
 -> HsConDetails
      (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn]))
-> [LHsType GhcRn]
-> HsConDetails
     (LHsType GhcRn) (GenLocated SrcSpan [LConDeclField GhcRn])
forall a b. (a -> b) -> a -> b
$ (ConDeclField GhcRn -> LHsType GhcRn)
-> [ConDeclField GhcRn] -> [LHsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map ConDeclField GhcRn -> LHsType GhcRn
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type ((LConDeclField GhcRn -> ConDeclField GhcRn)
-> [LConDeclField GhcRn] -> [ConDeclField GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map LConDeclField GhcRn -> ConDeclField GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LConDeclField GhcRn]
recs)) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                          [((LFieldOcc GhcRn -> [String]) -> [LFieldOcc GhcRn] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Located Name
-> [String]
lookupCon DynFlags
dflags [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (Located Name -> [String])
-> (LFieldOcc GhcRn -> Located Name) -> LFieldOcc GhcRn -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (Name -> Located Name)
-> (LFieldOcc GhcRn -> Name) -> LFieldOcc GhcRn -> Located Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (FieldOcc GhcRn -> Name)
-> (LFieldOcc GhcRn -> FieldOcc GhcRn) -> LFieldOcc GhcRn -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc GhcRn -> FieldOcc GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (ConDeclField GhcRn -> [LFieldOcc GhcRn]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcRn
r)) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                           [DynFlags -> [Name] -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags ((LFieldOcc GhcRn -> Name) -> [LFieldOcc GhcRn] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
extFieldOcc (FieldOcc GhcRn -> Name)
-> (LFieldOcc GhcRn -> FieldOcc GhcRn) -> LFieldOcc GhcRn -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LFieldOcc GhcRn -> FieldOcc GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LFieldOcc GhcRn] -> [Name]) -> [LFieldOcc GhcRn] -> [Name]
forall a b. (a -> b) -> a -> b
$ ConDeclField GhcRn -> [LFieldOcc GhcRn]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcRn
r) String -> [LHsType GhcRn] -> String
`typeSig` [LHsType GhcRn
resType, ConDeclField GhcRn -> LHsType GhcRn
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type ConDeclField GhcRn
r]]
                          | ConDeclField GhcRn
r <- (LConDeclField GhcRn -> ConDeclField GhcRn)
-> [LConDeclField GhcRn] -> [ConDeclField GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map LConDeclField GhcRn -> ConDeclField GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [LConDeclField GhcRn]
recs]

        funs :: [LHsType GhcRn] -> LHsType GhcRn
funs = (LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn)
-> [LHsType GhcRn] -> LHsType GhcRn
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\LHsType GhcRn
x LHsType GhcRn
y -> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn)
-> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a b. (a -> b) -> a -> b
$ XFunTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XFunTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy NoExtField
XFunTy GhcRn
noExtField LHsType GhcRn
x LHsType GhcRn
y)
        apps :: [LHsType GhcRn] -> LHsType GhcRn
apps = (LHsType GhcRn -> LHsType GhcRn -> LHsType GhcRn)
-> [LHsType GhcRn] -> LHsType GhcRn
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\LHsType GhcRn
x LHsType GhcRn
y -> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn)
-> SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a b. (a -> b) -> a -> b
$ XAppTy GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy NoExtField
XAppTy GhcRn
noExtField LHsType GhcRn
x LHsType GhcRn
y)

        typeSig :: String -> [LHsType GhcRn] -> String
typeSig String
nm [LHsType GhcRn]
flds = String -> String
operator String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> HsType GhcRn -> String
forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> HsType (GhcPass p) -> String
outHsType DynFlags
dflags (LHsType GhcRn -> SrcSpanLess (LHsType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (LHsType GhcRn -> SrcSpanLess (LHsType GhcRn))
-> LHsType GhcRn -> SrcSpanLess (LHsType GhcRn)
forall a b. (a -> b) -> a -> b
$ [LHsType GhcRn] -> LHsType GhcRn
funs [LHsType GhcRn]
flds)

        -- We print the constructors as comma-separated list. See GHC
        -- docs for con_names on why it is a list to begin with.
        name :: String
name = DynFlags -> [Name] -> String
forall a. Outputable a => DynFlags -> [a] -> String
commaSeparate DynFlags
dflags ([Name] -> String)
-> ([Located Name] -> [Name]) -> [Located Name] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([Located Name] -> String) -> [Located Name] -> String
forall a b. (a -> b) -> a -> b
$ ConDecl GhcRn -> [Located (IdP GhcRn)]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDecl GhcRn
con

        resType :: LHsType GhcRn
resType = let c :: HsType GhcRn
c  = XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcRn
noExtField PromotionFlag
NotPromoted (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (TyClDecl GhcRn -> IdP GhcRn
forall (p :: Pass). TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl GhcRn
dat))
                      as :: [HsType GhcRn]
as = (LHsTyVarBndr GhcRn -> HsType GhcRn)
-> [LHsTyVarBndr GhcRn] -> [HsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (HsTyVarBndr GhcRn -> HsType GhcRn
tyVarBndr2Type (HsTyVarBndr GhcRn -> HsType GhcRn)
-> (LHsTyVarBndr GhcRn -> HsTyVarBndr GhcRn)
-> LHsTyVarBndr GhcRn
-> HsType GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsTyVarBndr GhcRn -> HsTyVarBndr GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) (LHsQTyVars GhcRn -> [LHsTyVarBndr GhcRn]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsQTvExplicit (LHsQTyVars GhcRn -> [LHsTyVarBndr GhcRn])
-> LHsQTyVars GhcRn -> [LHsTyVarBndr GhcRn]
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcRn -> LHsQTyVars GhcRn
forall pass. TyClDecl pass -> LHsQTyVars pass
tyClDeclTyVars TyClDecl GhcRn
dat)
                  in [LHsType GhcRn] -> LHsType GhcRn
apps ((HsType GhcRn -> LHsType GhcRn)
-> [HsType GhcRn] -> [LHsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map HsType GhcRn -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (HsType GhcRn
c HsType GhcRn -> [HsType GhcRn] -> [HsType GhcRn]
forall a. a -> [a] -> [a]
: [HsType GhcRn]
as))

        tyVarBndr2Type :: HsTyVarBndr GhcRn -> HsType GhcRn
        tyVarBndr2Type :: HsTyVarBndr GhcRn -> HsType GhcRn
tyVarBndr2Type (UserTyVar XUserTyVar GhcRn
_ Located (IdP GhcRn)
n) = XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcRn
noExtField PromotionFlag
NotPromoted Located (IdP GhcRn)
n
        tyVarBndr2Type (KindedTyVar XKindedTyVar GhcRn
_ Located (IdP GhcRn)
n LHsType GhcRn
k) = XKindSig GhcRn -> LHsType GhcRn -> LHsType GhcRn -> HsType GhcRn
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig NoExtField
XKindSig GhcRn
noExtField (SrcSpanLess (LHsType GhcRn) -> LHsType GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XTyVar GhcRn
-> PromotionFlag -> Located (IdP GhcRn) -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcRn
noExtField PromotionFlag
NotPromoted Located (IdP GhcRn)
n)) LHsType GhcRn
k
        tyVarBndr2Type (XTyVarBndr XXTyVarBndr GhcRn
nec) = NoExtCon -> HsType GhcRn
forall a. NoExtCon -> a
noExtCon NoExtCon
XXTyVarBndr GhcRn
nec

ppCtor DynFlags
dflags TyClDecl GhcRn
_dat [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs con :: ConDecl GhcRn
con@(ConDeclGADT { })
   = (Located Name -> [String]) -> [Located Name] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Located Name
-> [String]
lookupCon DynFlags
dflags [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs) (ConDecl GhcRn -> [Located (IdP GhcRn)]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDecl GhcRn
con) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
f
    where
        f :: [String]
f = [String -> LHsType GhcRn -> String
typeSig String
name (ConDecl GhcRn -> LHsType GhcRn
forall (p :: Pass). ConDecl (GhcPass p) -> LHsType (GhcPass p)
getGADTConTypeG ConDecl GhcRn
con)]

        typeSig :: String -> LHsType GhcRn -> String
typeSig String
nm LHsType GhcRn
ty = String -> String
operator String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DynFlags -> HsType GhcRn -> String
forall (p :: Pass).
OutputableBndrId p =>
DynFlags -> HsType (GhcPass p) -> String
outHsType DynFlags
dflags (LHsType GhcRn -> SrcSpanLess (LHsType GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsType GhcRn
ty)
        name :: String
name = DynFlags -> [Name] -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags ([Name] -> String) -> [Name] -> String
forall a b. (a -> b) -> a -> b
$ (Located Name -> Name) -> [Located Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Located Name -> Name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([Located Name] -> [Name]) -> [Located Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ ConDecl GhcRn -> [Located (IdP GhcRn)]
forall (p :: Pass).
ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))]
getConNames ConDecl GhcRn
con
ppCtor DynFlags
_ TyClDecl GhcRn
_ [(Name, (Documentation Name, FnArgsDoc Name))]
_ (XConDecl XXConDecl GhcRn
nec) = NoExtCon -> [String]
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl GhcRn
nec

ppFixity :: DynFlags -> (Name, Fixity) -> [String]
ppFixity :: DynFlags -> (Name, Fixity) -> [String]
ppFixity DynFlags
dflags (Name
name, Fixity
fixity) = [DynFlags -> FixitySig GhcRn -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags ((XFixitySig GhcRn
-> [Located (IdP GhcRn)] -> Fixity -> FixitySig GhcRn
forall pass.
XFixitySig pass -> [Located (IdP pass)] -> Fixity -> FixitySig pass
FixitySig NoExtField
XFixitySig GhcRn
noExtField [SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located Name)
Name
name] Fixity
fixity) :: FixitySig GhcRn)]


---------------------------------------------------------------------
-- DOCUMENTATION

ppDocumentation :: Outputable o => DynFlags -> Documentation o -> [String]
ppDocumentation :: DynFlags -> Documentation o -> [String]
ppDocumentation DynFlags
dflags (Documentation Maybe (MDoc o)
d Maybe (Doc o)
w) = DynFlags -> Maybe (MDoc o) -> [String]
forall o. Outputable o => DynFlags -> Maybe (MDoc o) -> [String]
mdoc DynFlags
dflags Maybe (MDoc o)
d [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ DynFlags -> Maybe (Doc o) -> [String]
forall o. Outputable o => DynFlags -> Maybe (Doc o) -> [String]
doc DynFlags
dflags Maybe (Doc o)
w


doc :: Outputable o => DynFlags -> Maybe (Doc o) -> [String]
doc :: DynFlags -> Maybe (Doc o) -> [String]
doc DynFlags
dflags = DynFlags -> String -> Maybe (Doc o) -> [String]
forall o.
Outputable o =>
DynFlags -> String -> Maybe (Doc o) -> [String]
docWith DynFlags
dflags String
""

mdoc :: Outputable o => DynFlags -> Maybe (MDoc o) -> [String]
mdoc :: DynFlags -> Maybe (MDoc o) -> [String]
mdoc DynFlags
dflags = DynFlags -> String -> Maybe (Doc o) -> [String]
forall o.
Outputable o =>
DynFlags -> String -> Maybe (Doc o) -> [String]
docWith DynFlags
dflags String
"" (Maybe (Doc o) -> [String])
-> (Maybe (MDoc o) -> Maybe (Doc o)) -> Maybe (MDoc o) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MDoc o -> Doc o) -> Maybe (MDoc o) -> Maybe (Doc o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MDoc o -> Doc o
forall mod id. MetaDoc mod id -> DocH mod id
_doc

docWith :: Outputable o => DynFlags -> String -> Maybe (Doc o) -> [String]
docWith :: DynFlags -> String -> Maybe (Doc o) -> [String]
docWith DynFlags
_ [] Maybe (Doc o)
Nothing = []
docWith DynFlags
dflags String
header Maybe (Doc o)
d
  = (String
""String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String
"-- | " String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
forall a. a -> [a]
repeat String
"--   ") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
    String -> [String]
lines String
header [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"" | String
header String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" Bool -> Bool -> Bool
&& Maybe (Doc o) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Doc o)
d] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String] -> (Doc o -> [String]) -> Maybe (Doc o) -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ([Tag] -> [String]
showTags ([Tag] -> [String]) -> (Doc o -> [Tag]) -> Doc o -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocMarkupH (Wrap (ModuleName, OccName)) (Wrap o) [Tag]
-> Doc o -> [Tag]
forall mod id a. DocMarkupH mod id a -> DocH mod id -> a
markup (DynFlags -> DocMarkupH (Wrap (ModuleName, OccName)) (Wrap o) [Tag]
forall o. Outputable o => DynFlags -> DocMarkup o [Tag]
markupTag DynFlags
dflags)) Maybe (Doc o)
d

mkSubdoc :: DynFlags -> Located Name -> [(Name, DocForDecl Name)] -> [String] -> [String]
mkSubdoc :: DynFlags
-> Located Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdoc DynFlags
dflags Located Name
n [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs [String]
s = (Documentation Name -> [String])
-> [Documentation Name] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (DynFlags -> Documentation Name -> [String]
forall o. Outputable o => DynFlags -> Documentation o -> [String]
ppDocumentation DynFlags
dflags) [Documentation Name]
getDoc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
s
 where
   getDoc :: [Documentation Name]
getDoc = [Documentation Name]
-> ((Documentation Name, FnArgsDoc Name) -> [Documentation Name])
-> Maybe (Documentation Name, FnArgsDoc Name)
-> [Documentation Name]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Documentation Name -> [Documentation Name]
forall (m :: * -> *) a. Monad m => a -> m a
return (Documentation Name -> [Documentation Name])
-> ((Documentation Name, FnArgsDoc Name) -> Documentation Name)
-> (Documentation Name, FnArgsDoc Name)
-> [Documentation Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Documentation Name, FnArgsDoc Name) -> Documentation Name
forall a b. (a, b) -> a
fst) (Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> Maybe (Documentation Name, FnArgsDoc Name)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Located Name -> SrcSpanLess (Located Name)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located Name
n) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs)

data Tag = TagL Char [Tags] | TagP Tags | TagPre Tags | TagInline String Tags | Str String
           deriving Int -> Tag -> String -> String
[Tag] -> String -> String
Tag -> String
(Int -> Tag -> String -> String)
-> (Tag -> String) -> ([Tag] -> String -> String) -> Show Tag
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Tag] -> String -> String
$cshowList :: [Tag] -> String -> String
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> String -> String
$cshowsPrec :: Int -> Tag -> String -> String
Show

type Tags = [Tag]

box :: (a -> b) -> a -> [b]
box :: (a -> b) -> a -> [b]
box a -> b
f a
x = [a -> b
f a
x]

str :: String -> [Tag]
str :: String -> [Tag]
str String
a = [String -> Tag
Str String
a]

-- want things like paragraph, pre etc to be handled by blank lines in the source document
-- and things like \n and \t converted away
-- much like blogger in HTML mode
-- everything else wants to be included as tags, neatly nested for some (ul,li,ol)
-- or inlne for others (a,i,tt)
-- entities (&,>,<) should always be appropriately escaped

markupTag :: Outputable o => DynFlags -> DocMarkup o [Tag]
markupTag :: DynFlags -> DocMarkup o [Tag]
markupTag DynFlags
dflags = Markup :: forall mod id a.
a
-> (String -> a)
-> (a -> a)
-> (a -> a -> a)
-> (id -> a)
-> (mod -> a)
-> (ModLink a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> ([a] -> a)
-> ([a] -> a)
-> ([(a, a)] -> a)
-> (a -> a)
-> (Hyperlink a -> a)
-> (String -> a)
-> (Picture -> a)
-> (String -> a)
-> (String -> a)
-> (String -> a)
-> ([Example] -> a)
-> (Header a -> a)
-> (Table a -> a)
-> DocMarkupH mod id a
Markup {
  markupParagraph :: [Tag] -> [Tag]
markupParagraph            = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box [Tag] -> Tag
TagP,
  markupEmpty :: [Tag]
markupEmpty                = String -> [Tag]
str String
"",
  markupString :: String -> [Tag]
markupString               = String -> [Tag]
str,
  markupAppend :: [Tag] -> [Tag] -> [Tag]
markupAppend               = [Tag] -> [Tag] -> [Tag]
forall a. [a] -> [a] -> [a]
(++),
  markupIdentifier :: o -> [Tag]
markupIdentifier           = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"a") ([Tag] -> [Tag]) -> (o -> [Tag]) -> o -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag]
str (String -> [Tag]) -> (o -> String) -> o -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> o -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags,
  markupIdentifierUnchecked :: Wrap (ModuleName, OccName) -> [Tag]
markupIdentifierUnchecked  = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"a") ([Tag] -> [Tag])
-> (Wrap (ModuleName, OccName) -> [Tag])
-> Wrap (ModuleName, OccName)
-> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag]
str (String -> [Tag])
-> (Wrap (ModuleName, OccName) -> String)
-> Wrap (ModuleName, OccName)
-> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ModuleName, OccName) -> String)
-> Wrap (ModuleName, OccName) -> String
forall a. (a -> String) -> Wrap a -> String
showWrapped (DynFlags -> OccName -> String
forall a. Outputable a => DynFlags -> a -> String
out DynFlags
dflags (OccName -> String)
-> ((ModuleName, OccName) -> OccName)
-> (ModuleName, OccName)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName, OccName) -> OccName
forall a b. (a, b) -> b
snd),
  markupModule :: ModLink [Tag] -> [Tag]
markupModule               = \(ModLink String
m Maybe [Tag]
label) -> ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"a") ([Tag] -> Maybe [Tag] -> [Tag]
forall a. a -> Maybe a -> a
fromMaybe (String -> [Tag]
str String
m) Maybe [Tag]
label),
  markupWarning :: [Tag] -> [Tag]
markupWarning              = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"i"),
  markupEmphasis :: [Tag] -> [Tag]
markupEmphasis             = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"i"),
  markupBold :: [Tag] -> [Tag]
markupBold                 = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"b"),
  markupMonospaced :: [Tag] -> [Tag]
markupMonospaced           = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"tt"),
  markupPic :: Picture -> [Tag]
markupPic                  = [Tag] -> Picture -> [Tag]
forall a b. a -> b -> a
const ([Tag] -> Picture -> [Tag]) -> [Tag] -> Picture -> [Tag]
forall a b. (a -> b) -> a -> b
$ String -> [Tag]
str String
" ",
  markupMathInline :: String -> [Tag]
markupMathInline           = [Tag] -> String -> [Tag]
forall a b. a -> b -> a
const ([Tag] -> String -> [Tag]) -> [Tag] -> String -> [Tag]
forall a b. (a -> b) -> a -> b
$ String -> [Tag]
str String
"<math>",
  markupMathDisplay :: String -> [Tag]
markupMathDisplay          = [Tag] -> String -> [Tag]
forall a b. a -> b -> a
const ([Tag] -> String -> [Tag]) -> [Tag] -> String -> [Tag]
forall a b. (a -> b) -> a -> b
$ String -> [Tag]
str String
"<math>",
  markupUnorderedList :: [[Tag]] -> [Tag]
markupUnorderedList        = ([[Tag]] -> Tag) -> [[Tag]] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (Char -> [[Tag]] -> Tag
TagL Char
'u'),
  markupOrderedList :: [[Tag]] -> [Tag]
markupOrderedList          = ([[Tag]] -> Tag) -> [[Tag]] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (Char -> [[Tag]] -> Tag
TagL Char
'o'),
  markupDefList :: [([Tag], [Tag])] -> [Tag]
markupDefList              = ([[Tag]] -> Tag) -> [[Tag]] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (Char -> [[Tag]] -> Tag
TagL Char
'u') ([[Tag]] -> [Tag])
-> ([([Tag], [Tag])] -> [[Tag]]) -> [([Tag], [Tag])] -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Tag], [Tag]) -> [Tag]) -> [([Tag], [Tag])] -> [[Tag]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Tag]
a,[Tag]
b) -> String -> [Tag] -> Tag
TagInline String
"i" [Tag]
a Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
: String -> Tag
Str String
" " Tag -> [Tag] -> [Tag]
forall a. a -> [a] -> [a]
: [Tag]
b),
  markupCodeBlock :: [Tag] -> [Tag]
markupCodeBlock            = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box [Tag] -> Tag
TagPre,
  markupHyperlink :: Hyperlink [Tag] -> [Tag]
markupHyperlink            = \(Hyperlink String
url Maybe [Tag]
mLabel) -> ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"a") ([Tag] -> Maybe [Tag] -> [Tag]
forall a. a -> Maybe a -> a
fromMaybe (String -> [Tag]
str String
url) Maybe [Tag]
mLabel),
  markupAName :: String -> [Tag]
markupAName                = [Tag] -> String -> [Tag]
forall a b. a -> b -> a
const ([Tag] -> String -> [Tag]) -> [Tag] -> String -> [Tag]
forall a b. (a -> b) -> a -> b
$ String -> [Tag]
str String
"",
  markupProperty :: String -> [Tag]
markupProperty             = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box [Tag] -> Tag
TagPre ([Tag] -> [Tag]) -> (String -> [Tag]) -> String -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag]
str,
  markupExample :: [Example] -> [Tag]
markupExample              = ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box [Tag] -> Tag
TagPre ([Tag] -> [Tag]) -> ([Example] -> [Tag]) -> [Example] -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag]
str (String -> [Tag]) -> ([Example] -> String) -> [Example] -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> String)
-> ([Example] -> [String]) -> [Example] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Example -> String) -> [Example] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Example -> String
exampleToString,
  markupHeader :: Header [Tag] -> [Tag]
markupHeader               = \(Header Int
l [Tag]
h) -> ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline (String -> [Tag] -> Tag) -> String -> [Tag] -> Tag
forall a b. (a -> b) -> a -> b
$ String
"h" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l) [Tag]
h,
  markupTable :: Table [Tag] -> [Tag]
markupTable                = \(Table [TableRow [Tag]]
_ [TableRow [Tag]]
_) -> String -> [Tag]
str String
"TODO: table"
  }


showTags :: [Tag] -> [String]
showTags :: [Tag] -> [String]
showTags = [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""] ([[String]] -> [String])
-> ([Tag] -> [[String]]) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag -> [String]) -> [Tag] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> [String]
showBlock


showBlock :: Tag -> [String]
showBlock :: Tag -> [String]
showBlock (TagP [Tag]
xs) = [Tag] -> [String]
showInline [Tag]
xs
showBlock (TagL Char
t [[Tag]]
xs) = [Char
'<'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
tChar -> String -> String
forall a. a -> [a] -> [a]
:String
"l>"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
mid [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Char
'<'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'/'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
tChar -> String -> String
forall a. a -> [a] -> [a]
:String
"l>"]
    where mid :: [String]
mid = ([Tag] -> [String]) -> [[Tag]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Tag] -> [String]
showInline ([Tag] -> [String]) -> ([Tag] -> [Tag]) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Tag] -> Tag) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (String -> [Tag] -> Tag
TagInline String
"li")) [[Tag]]
xs
showBlock (TagPre [Tag]
xs) = [String
"<pre>"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Tag] -> [String]
showPre [Tag]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"</pre>"]
showBlock Tag
x = [Tag] -> [String]
showInline [Tag
x]


asInline :: Tag -> Tags
asInline :: Tag -> [Tag]
asInline (TagP [Tag]
xs) = [Tag]
xs
asInline (TagPre [Tag]
xs) = [String -> [Tag] -> Tag
TagInline String
"pre" [Tag]
xs]
asInline (TagL Char
t [[Tag]]
xs) = [String -> [Tag] -> Tag
TagInline (Char
tChar -> String -> String
forall a. a -> [a] -> [a]
:String
"l") ([Tag] -> Tag) -> [Tag] -> Tag
forall a b. (a -> b) -> a -> b
$ ([Tag] -> Tag) -> [[Tag]] -> [Tag]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [Tag] -> Tag
TagInline String
"li") [[Tag]]
xs]
asInline Tag
x = [Tag
x]


showInline :: [Tag] -> [String]
showInline :: [Tag] -> [String]
showInline = Int -> [String] -> [String]
unwordsWrap Int
70 ([String] -> [String]) -> ([Tag] -> [String]) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String]) -> ([Tag] -> String) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag -> String) -> [Tag] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tag -> String
f
    where
        fs :: [Tag] -> String
fs = (Tag -> String) -> [Tag] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tag -> String
f
        f :: Tag -> String
f (Str String
x) = String -> String
escape String
x
        f (TagInline String
s [Tag]
xs) = String
"<"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"li" then String -> String
trim else String -> String
forall a. a -> a
id) ([Tag] -> String
fs [Tag]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
">"
        f Tag
x = [Tag] -> String
fs ([Tag] -> String) -> [Tag] -> String
forall a b. (a -> b) -> a -> b
$ Tag -> [Tag]
asInline Tag
x

        trim :: String -> String
trim = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse


showPre :: [Tag] -> [String]
showPre :: [Tag] -> [String]
showPre = [String] -> [String]
trimFront ([String] -> [String]) -> ([Tag] -> [String]) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [[a]] -> [[a]]
trimLines ([String] -> [String]) -> ([Tag] -> [String]) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String]) -> ([Tag] -> String) -> [Tag] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag -> String) -> [Tag] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tag -> String
f
    where
        trimLines :: [[a]] -> [[a]]
trimLines = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[a]] -> [[a]]
forall a. [a] -> [a]
reverse
        trimFront :: [String] -> [String]
trimFront [String]
xs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
i) [String]
xs
            where
                ns :: [Int]
ns = [String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a | String
x <- [String]
xs, let (String
a,String
b) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
x, String
b String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""]
                i :: Int
i = if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ns then Int
0 else [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
ns

        fs :: [Tag] -> String
fs = (Tag -> String) -> [Tag] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tag -> String
f
        f :: Tag -> String
f (Str String
x) = String -> String
escape String
x
        f (TagInline String
s [Tag]
xs) = String
"<"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
">" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Tag] -> String
fs [Tag]
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"</"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
">"
        f Tag
x = [Tag] -> String
fs ([Tag] -> String) -> [Tag] -> String
forall a b. (a -> b) -> a -> b
$ Tag -> [Tag]
asInline Tag
x


unwordsWrap :: Int -> [String] -> [String]
unwordsWrap :: Int -> [String] -> [String]
unwordsWrap Int
n = Int -> [String] -> [String] -> [String]
f Int
n []
    where
        f :: Int -> [String] -> [String] -> [String]
f Int
_ [String]
s [] = [[String] -> String
g [String]
s | [String]
s [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []]
        f Int
i [String]
s (String
x:[String]
xs) | Int
nx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = [String] -> String
g [String]
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> [String] -> [String] -> [String]
f (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [String
x] [String]
xs
                     | Bool
otherwise = Int -> [String] -> [String] -> [String]
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (String
xString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
s) [String]
xs
            where nx :: Int
nx = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x

        g :: [String] -> String
g = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse


escape :: String -> String
escape :: String -> String
escape = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f
    where
        f :: Char -> String
f Char
'<' = String
"&lt;"
        f Char
'>' = String
"&gt;"
        f Char
'&' = String
"&amp;"
        f Char
x = [Char
x]


-- | Just like 'vcat' but uses '($+$)' instead of '($$)'.
vcat' :: [SDoc] -> SDoc
vcat' :: [SDoc] -> SDoc
vcat' = (SDoc -> SDoc -> SDoc) -> SDoc -> [SDoc] -> SDoc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SDoc -> SDoc -> SDoc
($+$) SDoc
empty