{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- 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
  ( -- * Main entry point to Hoogle output generation
    ppHoogle

    -- * Utilities for generating Hoogle output during interface creation
  , ppExportD
  ) where

import Data.Char
import Data.Foldable (toList)
import Data.List (intercalate, isPrefixOf)
import Data.Maybe
import Data.Version
import GHC
import GHC.Core.InstEnv
import qualified GHC.Driver.DynFlags as DynFlags
import GHC.Driver.Ppr
import GHC.Plugins (TopLevelFlag (..))
import GHC.Types.SourceText
import GHC.Unit.State
import GHC.Utils.Outputable as Outputable
import GHC.Utils.Panic
import System.Directory
import System.FilePath

import Documentation.Haddock.Markup
import Haddock.GhcUtils
import Haddock.Types hiding (Version)
import Haddock.Utils hiding (out)

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

ppHoogle :: DynFlags -> UnitState -> String -> Version -> String -> Maybe (Doc RdrName) -> [Interface] -> FilePath -> IO ()
ppHoogle :: DynFlags
-> UnitState
-> String
-> Version
-> String
-> Maybe (Doc RdrName)
-> [Interface]
-> String
-> IO ()
ppHoogle DynFlags
dflags UnitState
unit_state 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 = maxBound}
    sDocContext :: SDocContext
sDocContext = DynFlags -> PprStyle -> SDocContext
DynFlags.initSDocContext DynFlags
dflags' PprStyle
Outputable.defaultUserStyle
    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]
++ SDocContext -> String -> Maybe (Doc RdrName) -> [String]
forall o.
Outputable o =>
SDocContext -> String -> Maybe (Doc o) -> [String]
docWith SDocContext
sDocContext (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 a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null (Version -> [Int]
versionBranch Version
version))
           ]
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [DynFlags -> SDocContext -> UnitState -> Interface -> [String]
ppModule DynFlags
dflags' SDocContext
sDocContext UnitState
unit_state Interface
i | Interface
i <- [Interface]
ifaces, DocOption
OptHide DocOption -> [DocOption] -> Bool
forall (t :: Type -> Type) 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 -> SDocContext -> UnitState -> Interface -> [String]
ppModule :: DynFlags -> SDocContext -> UnitState -> Interface -> [String]
ppModule DynFlags
dflags SDocContext
sDocContext UnitState
unit_state Interface
iface =
  String
""
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: SDocContext -> Documentation Name -> [String]
forall o.
Outputable o =>
SDocContext -> Documentation o -> [String]
ppDocumentation SDocContext
sDocContext (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 DocNameI -> [String])
-> [ExportItem DocNameI] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap ExportItem DocNameI -> [String]
ppExportItem (Interface -> [ExportItem DocNameI]
ifaceRnExportItems Interface
iface)
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (ClsInst -> [String]) -> [ClsInst] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (DynFlags -> UnitState -> ClsInst -> [String]
ppInstance DynFlags
dflags UnitState
unit_state) (Interface -> [ClsInst]
ifaceInstances Interface
iface)

-- | If the export item is an 'ExportDecl', get the attached Hoogle textual
-- database entries for that export declaration.
ppExportItem :: ExportItem DocNameI -> [String]
ppExportItem :: ExportItem DocNameI -> [String]
ppExportItem (ExportDecl RnExportD{rnExpDHoogle :: RnExportD -> [String]
rnExpDHoogle = [String]
o}) = [String]
o
ppExportItem ExportItem DocNameI
_ = []

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

dropHsDocTy :: HsSigType GhcRn -> HsSigType GhcRn
dropHsDocTy :: HsSigType GhcRn -> HsSigType GhcRn
dropHsDocTy = HsSigType GhcRn -> HsSigType GhcRn
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
HsSigType pass -> HsSigType pass
drop_sig_ty
  where
    drop_sig_ty :: HsSigType pass -> HsSigType pass
drop_sig_ty (HsSig XHsSig pass
x HsOuterSigTyVarBndrs pass
a XRec pass (HsType pass)
b) = XHsSig pass
-> HsOuterSigTyVarBndrs pass
-> XRec pass (HsType pass)
-> HsSigType pass
forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
HsSig XHsSig pass
x HsOuterSigTyVarBndrs pass
a (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
forall {pass} {l}.
(XRec pass (HsType pass) ~ GenLocated l (HsType pass)) =>
GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
b)
    drop_sig_ty x :: HsSigType pass
x@XHsSigType{} = HsSigType pass
x

    drop_lty :: GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty (L l
src HsType pass
x) = l -> HsType pass -> GenLocated l (HsType pass)
forall l e. l -> e -> GenLocated l e
L l
src (HsType pass -> HsType pass
drop_ty HsType pass
x)

    drop_ty :: HsType pass -> HsType pass
drop_ty (HsForAllTy XForAllTy pass
x HsForAllTelescope pass
a XRec pass (HsType pass)
e) = XForAllTy pass
-> HsForAllTelescope pass -> XRec pass (HsType pass) -> HsType pass
forall pass.
XForAllTy pass
-> HsForAllTelescope pass -> LHsType pass -> HsType pass
HsForAllTy XForAllTy pass
x HsForAllTelescope pass
a (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
e)
    drop_ty (HsQualTy XQualTy pass
x LHsContext pass
a XRec pass (HsType pass)
e) = XQualTy pass
-> LHsContext pass -> XRec pass (HsType pass) -> HsType pass
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy XQualTy pass
x LHsContext pass
a (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
e)
    drop_ty (HsBangTy XBangTy pass
x HsBang
a XRec pass (HsType pass)
b) = XBangTy pass -> HsBang -> XRec pass (HsType pass) -> HsType pass
forall pass. XBangTy pass -> HsBang -> LHsType pass -> HsType pass
HsBangTy XBangTy pass
x HsBang
a (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
b)
    drop_ty (HsAppTy XAppTy pass
x XRec pass (HsType pass)
a XRec pass (HsType pass)
b) = XAppTy pass
-> XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy pass
x (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a) (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
b)
    drop_ty (HsAppKindTy XAppKindTy pass
x XRec pass (HsType pass)
a XRec pass (HsType pass)
b) = XAppKindTy pass
-> XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XAppKindTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppKindTy XAppKindTy pass
x (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a) (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
b)
    drop_ty (HsFunTy XFunTy pass
x HsArrow pass
w XRec pass (HsType pass)
a XRec pass (HsType pass)
b) = XFunTy pass
-> HsArrow pass
-> XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy pass
x HsArrow pass
w (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a) (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
b)
    drop_ty (HsListTy XListTy pass
x XRec pass (HsType pass)
a) = XListTy pass -> XRec pass (HsType pass) -> HsType pass
forall pass. XListTy pass -> LHsType pass -> HsType pass
HsListTy XListTy pass
x (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a)
    drop_ty (HsTupleTy XTupleTy pass
x HsTupleSort
a [XRec pass (HsType pass)]
b) = XTupleTy pass
-> HsTupleSort -> [XRec pass (HsType pass)] -> HsType pass
forall pass.
XTupleTy pass -> HsTupleSort -> [LHsType pass] -> HsType pass
HsTupleTy XTupleTy pass
x HsTupleSort
a ((GenLocated l (HsType pass) -> GenLocated l (HsType pass))
-> [GenLocated l (HsType pass)] -> [GenLocated l (HsType pass)]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty [XRec pass (HsType pass)]
[GenLocated l (HsType pass)]
b)
    drop_ty (HsOpTy XOpTy pass
x PromotionFlag
p XRec pass (HsType pass)
a LIdP pass
b XRec pass (HsType pass)
c) = XOpTy pass
-> PromotionFlag
-> XRec pass (HsType pass)
-> LIdP pass
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XOpTy pass
-> PromotionFlag
-> LHsType pass
-> LIdP pass
-> LHsType pass
-> HsType pass
HsOpTy XOpTy pass
x PromotionFlag
p (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a) LIdP pass
b (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
c)
    drop_ty (HsParTy XParTy pass
x XRec pass (HsType pass)
a) = XParTy pass -> XRec pass (HsType pass) -> HsType pass
forall pass. XParTy pass -> LHsType pass -> HsType pass
HsParTy XParTy pass
x (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a)
    drop_ty (HsKindSig XKindSig pass
x XRec pass (HsType pass)
a XRec pass (HsType pass)
b) = XKindSig pass
-> XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig XKindSig pass
x (GenLocated l (HsType pass) -> GenLocated l (HsType pass)
drop_lty XRec pass (HsType pass)
GenLocated l (HsType pass)
a) XRec pass (HsType pass)
b
    drop_ty (HsDocTy XDocTy pass
_ XRec pass (HsType pass)
a LHsDoc pass
_) = HsType pass -> HsType pass
drop_ty (HsType pass -> HsType pass) -> HsType pass -> HsType pass
forall a b. (a -> b) -> a -> b
$ GenLocated l (HsType pass) -> HsType pass
forall l a. GenLocated l a -> a
unL XRec pass (HsType pass)
GenLocated l (HsType pass)
a
    drop_ty HsType pass
x = HsType pass
x

outHsSigType :: SDocContext -> HsSigType GhcRn -> String
outHsSigType :: SDocContext -> HsSigType GhcRn -> String
outHsSigType SDocContext
sDocContext = SDocContext -> HsSigType GhcRn -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext (HsSigType GhcRn -> String)
-> (HsSigType GhcRn -> HsSigType GhcRn)
-> HsSigType GhcRn
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcRn -> HsSigType GhcRn
forall a. XRecCond a => HsSigType a -> HsSigType a
reparenSigType (HsSigType GhcRn -> HsSigType GhcRn)
-> (HsSigType GhcRn -> HsSigType GhcRn)
-> HsSigType GhcRn
-> HsSigType GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsSigType GhcRn -> HsSigType GhcRn
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 :: forall a. Outputable a => (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 => SDocContext -> a -> String
out :: forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext = (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
$ SDocContext -> SDoc -> String
Outputable.renderWithContext SDocContext
sDocContext

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 :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`notElem` String
"_' ([{" = Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x Char -> 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 => SDocContext -> [a] -> String
commaSeparate :: forall a. Outputable a => SDocContext -> [a] -> String
commaSeparate SDocContext
sDocContext = SDocContext -> SDoc -> String
Outputable.renderWithContext SDocContext
sDocContext (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

ppExportD :: DynFlags -> ExportD GhcRn -> [String]
ppExportD :: DynFlags -> ExportD GhcRn -> [String]
ppExportD
  DynFlags
dflags
  ExportD
    { expDDecl :: forall name. ExportD name -> LHsDecl name
expDDecl = L SrcSpanAnnA
_ HsDecl GhcRn
decl
    , expDPats :: forall name. ExportD name -> [(HsDecl name, DocForDecl (IdP name))]
expDPats = [(HsDecl GhcRn, DocForDecl (IdP GhcRn))]
bundledPats
    , expDMbDoc :: forall name. ExportD name -> DocForDecl (IdP name)
expDMbDoc = DocForDecl (IdP GhcRn)
mbDoc
    , expDSubDocs :: forall name. ExportD name -> [(IdP name, DocForDecl (IdP name))]
expDSubDocs = [(IdP GhcRn, DocForDecl (IdP GhcRn))]
subdocs
    , expDFixities :: forall name. ExportD name -> [(IdP name, Fixity)]
expDFixities = [(IdP GhcRn, Fixity)]
fixities
    } =
    [[String]] -> [String]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
      [ SDocContext -> Documentation Name -> [String]
forall o.
Outputable o =>
SDocContext -> Documentation o -> [String]
ppDocumentation SDocContext
sDocContext 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 :: HsDecl GhcRn -> [String]
f (TyClD XTyClD GhcRn
_ d :: TyClDecl GhcRn
d@DataDecl{}) = SDocContext
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppData SDocContext
sDocContext TyClDecl GhcRn
d [(IdP GhcRn, DocForDecl (IdP GhcRn))]
[(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
      f (TyClD XTyClD GhcRn
_ d :: TyClDecl GhcRn
d@SynDecl{}) = SDocContext -> TyClDecl GhcRn -> [String]
ppSynonym SDocContext
sDocContext TyClDecl GhcRn
d
      f (TyClD XTyClD GhcRn
_ d :: TyClDecl GhcRn
d@ClassDecl{}) = SDocContext
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppClass SDocContext
sDocContext TyClDecl GhcRn
d [(IdP GhcRn, DocForDecl (IdP GhcRn))]
[(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
      f (TyClD XTyClD GhcRn
_ (FamDecl XFamDecl GhcRn
_ FamilyDecl GhcRn
d)) = SDocContext -> FamilyDecl GhcRn -> [String]
ppFam SDocContext
sDocContext FamilyDecl GhcRn
d
      f (ForD XForD GhcRn
_ (ForeignImport XForeignImport GhcRn
_ LIdP GhcRn
name LHsSigType GhcRn
typ ForeignImport GhcRn
_)) = [SDocContext -> [LocatedN Name] -> LHsSigType GhcRn -> String
ppSig SDocContext
sDocContext [LIdP GhcRn
LocatedN Name
name] LHsSigType GhcRn
typ]
      f (ForD XForD GhcRn
_ (ForeignExport XForeignExport GhcRn
_ LIdP GhcRn
name LHsSigType GhcRn
typ ForeignExport GhcRn
_)) = [SDocContext -> [LocatedN Name] -> LHsSigType GhcRn -> String
ppSig SDocContext
sDocContext [LIdP GhcRn
LocatedN Name
name] LHsSigType GhcRn
typ]
      f (SigD XSigD GhcRn
_ Sig GhcRn
sig) = SDocContext
-> Sig GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppSigWithDoc SDocContext
sDocContext Sig GhcRn
sig []
      f HsDecl GhcRn
_ = []

      ppFixities :: [String]
      ppFixities :: [String]
ppFixities = ((Name, Fixity) -> [String]) -> [(Name, Fixity)] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SDocContext -> (Name, Fixity) -> [String]
ppFixity SDocContext
sDocContext) [(IdP GhcRn, Fixity)]
[(Name, Fixity)]
fixities

      sDocContext :: SDocContext
sDocContext = DynFlags -> PprStyle -> SDocContext
DynFlags.initSDocContext DynFlags
dflags PprStyle
Outputable.defaultUserStyle

ppSigWithDoc :: SDocContext -> Sig GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppSigWithDoc :: SDocContext
-> Sig GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppSigWithDoc SDocContext
sDocContext Sig GhcRn
sig [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs = case Sig GhcRn
sig of
  TypeSig XTypeSig GhcRn
_ [LIdP GhcRn]
names LHsSigWcType GhcRn
t -> (LocatedN Name -> [String]) -> [LocatedN Name] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (String
-> GenLocated SrcSpanAnnA (HsSigType GhcRn)
-> LocatedN Name
-> [String]
mkDocSig String
"" (LHsSigWcType GhcRn -> LHsSigType GhcRn
forall pass. LHsSigWcType pass -> LHsSigType pass
dropWildCards LHsSigWcType GhcRn
t)) [LIdP GhcRn]
[LocatedN Name]
names
  PatSynSig XPatSynSig GhcRn
_ [LIdP GhcRn]
names LHsSigType GhcRn
t -> (LocatedN Name -> [String]) -> [LocatedN Name] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (String
-> GenLocated SrcSpanAnnA (HsSigType GhcRn)
-> LocatedN Name
-> [String]
mkDocSig String
"pattern " LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
t) [LIdP GhcRn]
[LocatedN Name]
names
  Sig GhcRn
_ -> []
  where
    mkDocSig :: String
-> GenLocated SrcSpanAnnA (HsSigType GhcRn)
-> LocatedN Name
-> [String]
mkDocSig String
leader GenLocated SrcSpanAnnA (HsSigType GhcRn)
typ LocatedN Name
n =
      SDocContext
-> LocatedN Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdocN
        SDocContext
sDocContext
        LocatedN Name
n
        [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
        [String
leader String -> String -> String
forall a. [a] -> [a] -> [a]
++ SDocContext -> [LocatedN Name] -> LHsSigType GhcRn -> String
ppSig SDocContext
sDocContext [LocatedN Name
n] LHsSigType GhcRn
GenLocated SrcSpanAnnA (HsSigType GhcRn)
typ]

ppSig :: SDocContext -> [LocatedN Name] -> LHsSigType GhcRn -> String
ppSig :: SDocContext -> [LocatedN Name] -> LHsSigType GhcRn -> String
ppSig SDocContext
sDocContext [LocatedN Name]
names (L SrcSpanAnnA
_ HsSigType GhcRn
typ) =
  String -> String
operator String
prettyNames String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SDocContext -> HsSigType GhcRn -> String
outHsSigType SDocContext
sDocContext HsSigType 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
$ (LocatedN Name -> String) -> [LocatedN Name] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SDocContext -> LocatedN Name -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext) [LocatedN Name]
names

-- note: does not yet output documentation for class methods
ppClass :: SDocContext -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppClass :: SDocContext
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppClass SDocContext
sDocContext decl :: TyClDecl GhcRn
decl@(ClassDecl{}) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs =
  (String
ppDecl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ppTyFams) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ppMethods
  where
    ppDecl :: String
    ppDecl :: String
ppDecl =
      SDocContext -> TyClDecl GhcRn -> String
forall a. Outputable a => SDocContext -> a -> String
out
        SDocContext
sDocContext
        TyClDecl GhcRn
decl
          { tcdSigs = []
          , tcdATs = []
          , tcdATDefs = []
          , tcdMeths = emptyLHsBinds
          }

    ppMethods :: [String]
    ppMethods :: [String]
ppMethods = [[String]] -> [String]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([GenLocated SrcSpanAnnA (Sig GhcRn)] -> [[String]])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (Sig GhcRn) -> [String])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (Sig GhcRn -> [String]
ppSig' (Sig GhcRn -> [String])
-> (GenLocated SrcSpanAnnA (Sig GhcRn) -> Sig GhcRn)
-> GenLocated SrcSpanAnnA (Sig GhcRn)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Sig GhcRn) -> Sig GhcRn
forall l a. GenLocated l a -> a
unLoc (GenLocated SrcSpanAnnA (Sig GhcRn) -> Sig GhcRn)
-> (GenLocated SrcSpanAnnA (Sig GhcRn)
    -> GenLocated SrcSpanAnnA (Sig GhcRn))
-> GenLocated SrcSpanAnnA (Sig GhcRn)
-> Sig GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XRec GhcRn (Sig GhcRn) -> XRec GhcRn (Sig GhcRn)
GenLocated SrcSpanAnnA (Sig GhcRn)
-> GenLocated SrcSpanAnnA (Sig GhcRn)
add_ctxt) ([GenLocated SrcSpanAnnA (Sig GhcRn)] -> [String])
-> [GenLocated SrcSpanAnnA (Sig GhcRn)] -> [String]
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcRn -> [XRec GhcRn (Sig 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 (SDocContext
-> Sig GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppSigWithDoc SDocContext
sDocContext) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs

    add_ctxt :: XRec GhcRn (Sig GhcRn) -> XRec GhcRn (Sig GhcRn)
add_ctxt = Name
-> LHsQTyVars GhcRn
-> XRec GhcRn (Sig GhcRn)
-> XRec GhcRn (Sig GhcRn)
addClassContext (TyClDecl GhcRn -> IdP GhcRn
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
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 :: String
ppTyFams
      | [GenLocated SrcSpanAnnA (FamilyDecl GhcRn)] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([GenLocated SrcSpanAnnA (FamilyDecl GhcRn)] -> Bool)
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcRn)] -> Bool
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcRn -> [XRec GhcRn (FamilyDecl 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
. SDocContext -> SDoc -> String
Outputable.renderWithContext SDocContext
sDocContext (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 :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
              [ (GenLocated SrcSpanAnnA (FamilyDecl GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (FamilyDecl GhcRn)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map XRec GhcRn (FamilyDecl GhcRn) -> SDoc
GenLocated SrcSpanAnnA (FamilyDecl GhcRn) -> SDoc
pprTyFam (TyClDecl GhcRn -> [XRec GhcRn (FamilyDecl GhcRn)]
forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs TyClDecl GhcRn
decl)
              , (GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn) -> SDoc)
-> [GenLocated SrcSpanAnnA (TyFamInstDecl 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)
-> (GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn)
    -> TyFamInstDecl GhcRn)
-> GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn)
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn) -> TyFamInstDecl GhcRn
forall l a. GenLocated l a -> a
unLoc) (TyClDecl GhcRn -> [XRec GhcRn (TyFamInstDecl GhcRn)]
forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs TyClDecl GhcRn
decl)
              ]

    pprTyFam :: LFamilyDecl GhcRn -> SDoc
    pprTyFam :: XRec GhcRn (FamilyDecl GhcRn) -> SDoc
pprTyFam (L SrcSpanAnnA
_ 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
forall doc. IsLine doc => String -> doc
text ([String] -> [SDoc]) -> [String] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
          SDocContext
-> LocatedN Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdocN
            SDocContext
sDocContext
            (FamilyDecl GhcRn -> LIdP GhcRn
forall pass. FamilyDecl pass -> LIdP pass
fdLName FamilyDecl GhcRn
at)
            [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
            -- Associated type families should not be printed as top-level
            -- (avoid printing the `family` keyword)
            (SDocContext -> FamilyDecl GhcRn -> [String]
ppFam SDocContext
sDocContext FamilyDecl GhcRn
at{fdTopLevel = NotTopLevel})

    whereWrapper :: [SDoc] -> SDoc
whereWrapper [SDoc]
elems =
      [SDoc] -> SDoc
vcat'
        [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"where" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
forall doc. IsLine doc => doc
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
forall doc. IsDoc doc => [doc] -> doc
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
forall doc. IsLine doc => doc -> doc -> doc
Outputable.<> SDoc
forall doc. IsLine doc => doc
semi) ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc]
elems
        , SDoc
forall doc. IsLine doc => doc
rbrace
        ]
ppClass SDocContext
_ TyClDecl GhcRn
_non_cls_decl [(Name, (Documentation Name, FnArgsDoc Name))]
_ = []

ppFam :: SDocContext -> FamilyDecl GhcRn -> [String]
ppFam :: SDocContext -> FamilyDecl GhcRn -> [String]
ppFam SDocContext
sDocContext decl :: FamilyDecl GhcRn
decl@(FamilyDecl{fdInfo :: forall pass. FamilyDecl pass -> FamilyInfo pass
fdInfo = FamilyInfo GhcRn
info}) =
  [SDocContext -> FamilyDecl GhcRn -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext 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 = OpenTypeFamily}
      FamilyInfo GhcRn
_ -> FamilyDecl GhcRn
decl

ppInstance :: DynFlags -> UnitState -> ClsInst -> [String]
ppInstance :: DynFlags -> UnitState -> ClsInst -> [String]
ppInstance DynFlags
dflags UnitState
unit_state 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 -> UnitState -> NamePprCtx -> SDoc -> String
showSDocForUser DynFlags
dflags UnitState
unit_state NamePprCtx
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
              { overlapMode = NoOverlap NoSourceText
              , isSafeOverlap = False
              }
        }

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

ppData :: SDocContext -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> [String]
ppData :: SDocContext
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
ppData SDocContext
sDocContext decl :: TyClDecl GhcRn
decl@DataDecl{tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
name, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
tvs, tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdFixity = LexicalFixity
fixity, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcRn
defn} [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs =
  SDocContext -> SDoc -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext ((Maybe (LHsContext GhcRn) -> SDoc) -> HsDataDefn GhcRn -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
(Maybe (LHsContext (GhcPass p)) -> SDoc)
-> HsDataDefn (GhcPass p) -> SDoc
ppDataDefnHeader (LIdP GhcRn
-> LHsQTyVars GhcRn
-> LexicalFixity
-> Maybe (LHsContext GhcRn)
-> SDoc
forall (p :: Pass).
OutputableBndrId p =>
XRec (GhcPass p) (IdP (GhcPass p))
-> LHsQTyVars (GhcPass p)
-> LexicalFixity
-> Maybe (LHsContext (GhcPass p))
-> SDoc
pp_vanilla_decl_head LIdP GhcRn
name LHsQTyVars GhcRn
tvs LexicalFixity
fixity) HsDataDefn GhcRn
defn)
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (ConDecl GhcRn) -> [String])
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcRn))
-> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SDocContext
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> ConDecl GhcRn
-> [String]
ppCtor SDocContext
sDocContext TyClDecl GhcRn
decl [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (ConDecl GhcRn -> [String])
-> (GenLocated SrcSpanAnnA (ConDecl GhcRn) -> ConDecl GhcRn)
-> GenLocated SrcSpanAnnA (ConDecl GhcRn)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDecl GhcRn) -> ConDecl GhcRn
forall l a. GenLocated l a -> a
unLoc) (HsDataDefn GhcRn -> DataDefnCons (LConDecl GhcRn)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons HsDataDefn GhcRn
defn)
ppData SDocContext
_ TyClDecl GhcRn
_ [(Name, (Documentation Name, FnArgsDoc Name))]
_ = String -> [String]
forall a. HasCallStack => String -> a
panic String
"ppData"

-- | for constructors, and named-fields...
lookupCon :: SDocContext -> [(Name, DocForDecl Name)] -> LocatedN Name -> [String]
lookupCon :: SDocContext
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> LocatedN Name
-> [String]
lookupCon SDocContext
sDocContext [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (L SrcSpanAnnN
_ 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
_) -> SDocContext -> Documentation Name -> [String]
forall o.
Outputable o =>
SDocContext -> Documentation o -> [String]
ppDocumentation SDocContext
sDocContext Documentation Name
d
  Maybe (Documentation Name, FnArgsDoc Name)
_ -> []

ppCtor :: SDocContext -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]
ppCtor :: SDocContext
-> TyClDecl GhcRn
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> ConDecl GhcRn
-> [String]
ppCtor SDocContext
sDocContext TyClDecl GhcRn
dat [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs con :: ConDecl GhcRn
con@ConDeclH98{con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcRn
con_args'} =
  -- AZ:TODO get rid of the concatMap
  (LocatedN Name -> [String]) -> [LocatedN Name] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SDocContext
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> LocatedN Name
-> [String]
lookupCon SDocContext
sDocContext [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs) [ConDecl GhcRn -> LIdP GhcRn
forall pass. ConDecl pass -> LIdP pass
con_name ConDecl GhcRn
con] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ HsConDetails
  Void
  (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
-> [String]
f HsConDeclH98Details GhcRn
HsConDetails
  Void
  (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
con_args'
  where
    f :: HsConDetails
  Void
  (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
-> [String]
f (PrefixCon [Void]
_ [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
args) = [String -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> String
typeSig String
name ([GenLocated SrcSpanAnnA (HsType GhcRn)] -> String)
-> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> String
forall a b. (a -> b) -> a -> b
$ ((HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
 -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall pass a. HsScaled pass a -> a
hsScaledThing [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
args) [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (HsType GhcRn)
resType]]
    f (InfixCon HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
a1 HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
a2) = HsConDetails
  Void
  (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
-> [String]
f (HsConDetails
   Void
   (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
   (GenLocated
      SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
 -> [String])
-> HsConDetails
     Void
     (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
-> [String]
forall a b. (a -> b) -> a -> b
$ [Void]
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
-> HsConDetails
     Void
     (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
a1, HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
a2]
    f (RecCon (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
recs)) =
      HsConDetails
  Void
  (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
  (GenLocated
     SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
-> [String]
f ([Void]
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
-> HsConDetails
     Void
     (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [] ([HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
 -> HsConDetails
      Void
      (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
      (GenLocated
         SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]))
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
-> HsConDetails
     Void
     (HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
     (GenLocated
        SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)])
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
 -> HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> [HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map (GenLocated SrcSpanAnnA (HsType GhcRn)
-> HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
forall (p :: Pass) a. IsPass p => a -> HsScaled (GhcPass p) a
hsLinear (GenLocated SrcSpanAnnA (HsType GhcRn)
 -> HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
    -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (ConDeclField GhcRn)
-> HsScaled GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConDeclField GhcRn -> XRec GhcRn (HsType GhcRn)
ConDeclField GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type (ConDeclField GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
    -> ConDeclField GhcRn)
-> GenLocated SrcSpanAnnA (ConDeclField GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcRn) -> ConDeclField GhcRn
forall l a. GenLocated l a -> a
unLoc) [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
recs)
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat
          [ ((GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> [String])
-> [GenLocated SrcSpanAnnA (FieldOcc GhcRn)] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SDocContext
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> LocatedN Name
-> [String]
lookupCon SDocContext
sDocContext [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs (LocatedN Name -> [String])
-> (GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> LocatedN Name)
-> GenLocated SrcSpanAnnA (FieldOcc GhcRn)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> LocatedN Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (Name -> LocatedN Name)
-> (GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> Name)
-> GenLocated SrcSpanAnnA (FieldOcc GhcRn)
-> LocatedN Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldOcc GhcRn -> XCFieldOcc GhcRn
FieldOcc GhcRn -> Name
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc GhcRn -> Name)
-> (GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> FieldOcc GhcRn)
-> GenLocated SrcSpanAnnA (FieldOcc GhcRn)
-> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> FieldOcc GhcRn
forall l a. GenLocated l a -> 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]
++ [SDocContext -> [XCFieldOcc GhcRn] -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext ((GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> XCFieldOcc GhcRn)
-> [GenLocated SrcSpanAnnA (FieldOcc GhcRn)] -> [XCFieldOcc GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (FieldOcc GhcRn -> XCFieldOcc GhcRn
forall pass. FieldOcc pass -> XCFieldOcc pass
foExt (FieldOcc GhcRn -> XCFieldOcc GhcRn)
-> (GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> FieldOcc GhcRn)
-> GenLocated SrcSpanAnnA (FieldOcc GhcRn)
-> XCFieldOcc GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (FieldOcc GhcRn) -> FieldOcc GhcRn
forall l a. GenLocated l a -> a
unLoc) ([GenLocated SrcSpanAnnA (FieldOcc GhcRn)] -> [XCFieldOcc GhcRn])
-> [GenLocated SrcSpanAnnA (FieldOcc GhcRn)] -> [XCFieldOcc GhcRn]
forall a b. (a -> b) -> a -> b
$ ConDeclField GhcRn -> [LFieldOcc GhcRn]
forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_names ConDeclField GhcRn
r) String -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> String
`typeSig` [GenLocated SrcSpanAnnA (HsType GhcRn)
resType, ConDeclField GhcRn -> XRec GhcRn (HsType GhcRn)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type ConDeclField GhcRn
r]]
          | ConDeclField GhcRn
r <- (GenLocated SrcSpanAnnA (ConDeclField GhcRn) -> ConDeclField GhcRn)
-> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> [ConDeclField GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpanAnnA (ConDeclField GhcRn) -> ConDeclField GhcRn
forall l a. GenLocated l a -> a
unLoc [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
recs
          ]

    funs :: [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
funs = (GenLocated SrcSpanAnnA (HsType GhcRn)
 -> GenLocated SrcSpanAnnA (HsType GhcRn)
 -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 (\GenLocated SrcSpanAnnA (HsType GhcRn)
x GenLocated SrcSpanAnnA (HsType GhcRn)
y -> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a l. a -> GenLocated l a
reL (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a b. (a -> b) -> a -> b
$ XFunTy GhcRn
-> HsArrow GhcRn
-> XRec GhcRn (HsType GhcRn)
-> XRec GhcRn (HsType GhcRn)
-> HsType GhcRn
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy GhcRn
NoExtField
noExtField (XUnrestrictedArrow (XRec GhcRn (HsType GhcRn)) GhcRn
-> HsArrow GhcRn
forall mult pass.
XUnrestrictedArrow mult pass -> HsArrowOf mult pass
HsUnrestrictedArrow NoExtField
XUnrestrictedArrow (XRec GhcRn (HsType GhcRn)) GhcRn
noExtField) XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
x XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
y)
    apps :: [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
apps = (GenLocated SrcSpanAnnA (HsType GhcRn)
 -> GenLocated SrcSpanAnnA (HsType GhcRn)
 -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a. (a -> a -> a) -> [a] -> a
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldl1 (\GenLocated SrcSpanAnnA (HsType GhcRn)
x GenLocated SrcSpanAnnA (HsType GhcRn)
y -> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a l. a -> GenLocated l a
reL (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a b. (a -> b) -> a -> b
$ XAppTy GhcRn
-> XRec GhcRn (HsType GhcRn)
-> XRec GhcRn (HsType GhcRn)
-> HsType GhcRn
forall pass.
XAppTy pass -> LHsType pass -> LHsType pass -> HsType pass
HsAppTy XAppTy GhcRn
NoExtField
noExtField XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
x XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
y)

    typeSig :: String -> [GenLocated SrcSpanAnnA (HsType GhcRn)] -> String
typeSig String
nm [GenLocated SrcSpanAnnA (HsType GhcRn)]
flds =
      String -> String
operator String
nm
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ SDocContext -> HsSigType GhcRn -> String
outHsSigType SDocContext
sDocContext (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> HsSigType GhcRn
forall l a. GenLocated l a -> a
unL (GenLocated SrcSpanAnnA (HsSigType GhcRn) -> HsSigType GhcRn)
-> GenLocated SrcSpanAnnA (HsSigType GhcRn) -> HsSigType GhcRn
forall a b. (a -> b) -> a -> b
$ XRec GhcRn (HsType GhcRn) -> LHsSigType GhcRn
mkEmptySigType (XRec GhcRn (HsType GhcRn) -> LHsSigType GhcRn)
-> XRec GhcRn (HsType GhcRn) -> LHsSigType GhcRn
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
funs [GenLocated SrcSpanAnnA (HsType 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 = SDocContext -> [Name] -> String
forall a. Outputable a => SDocContext -> [a] -> String
commaSeparate SDocContext
sDocContext ([Name] -> String) -> ([Name] -> [Name]) -> [Name] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> [Name]
forall a. [a] -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList ([Name] -> String) -> [Name] -> String
forall a b. (a -> b) -> a -> b
$ LocatedN Name -> Name
forall l a. GenLocated l a -> a
unL (LocatedN Name -> Name) -> [LocatedN Name] -> [Name]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ConDecl GhcRn -> [LocatedN Name]
getConNames ConDecl GhcRn
con

    tyVarArg :: HsTyVarBndr flag GhcRn -> HsType GhcRn
tyVarArg (HsTvb { tvb_var :: forall flag pass. HsTyVarBndr flag pass -> HsBndrVar pass
tvb_var = HsBndrVar GhcRn
bvar, tvb_kind :: forall flag pass. HsTyVarBndr flag pass -> HsBndrKind pass
tvb_kind = HsBndrKind GhcRn
bkind }) = HsType GhcRn
tvk
      where
        tv, tvk :: HsType GhcRn
        tv :: HsType GhcRn
tv = case HsBndrVar GhcRn
bvar of
          HsBndrVar XBndrVar GhcRn
_ LIdP GhcRn
n -> XTyVar GhcRn -> PromotionFlag -> LIdP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar [AddEpAnn]
XTyVar GhcRn
forall a. NoAnn a => a
noAnn PromotionFlag
NotPromoted LIdP GhcRn
n
          HsBndrWildCard XBndrWildCard GhcRn
_ -> XWildCardTy GhcRn -> HsType GhcRn
forall pass. XWildCardTy pass -> HsType pass
HsWildCardTy XWildCardTy GhcRn
NoExtField
noExtField
        tvk :: HsType GhcRn
tvk = case HsBndrKind GhcRn
bkind of
          HsBndrNoKind XBndrNoKind GhcRn
_   -> HsType GhcRn
tv
          HsBndrKind XBndrKind GhcRn
_ XRec GhcRn (HsType GhcRn)
lty -> XKindSig GhcRn
-> XRec GhcRn (HsType GhcRn)
-> XRec GhcRn (HsType GhcRn)
-> HsType GhcRn
forall pass.
XKindSig pass -> LHsType pass -> LHsType pass -> HsType pass
HsKindSig [AddEpAnn]
XKindSig GhcRn
forall a. NoAnn a => a
noAnn (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a l. a -> GenLocated l a
reL HsType GhcRn
tv) XRec GhcRn (HsType GhcRn)
lty

    resType :: GenLocated SrcSpanAnnA (HsType GhcRn)
resType =
      [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
apps ([GenLocated SrcSpanAnnA (HsType GhcRn)]
 -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a b. (a -> b) -> a -> b
$
        (HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [HsType GhcRn] -> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a l. a -> GenLocated l a
reL ([HsType GhcRn] -> [GenLocated SrcSpanAnnA (HsType GhcRn)])
-> [HsType GhcRn] -> [GenLocated SrcSpanAnnA (HsType GhcRn)]
forall a b. (a -> b) -> a -> b
$
          (XTyVar GhcRn -> PromotionFlag -> LIdP GhcRn -> HsType GhcRn
forall pass.
XTyVar pass -> PromotionFlag -> LIdP pass -> HsType pass
HsTyVar [AddEpAnn]
XTyVar GhcRn
forall a. NoAnn a => a
noAnn PromotionFlag
NotPromoted (Name -> LocatedN Name
forall a l. a -> GenLocated l a
reL (TyClDecl GhcRn -> IdP GhcRn
forall (p :: Pass).
(Anno (IdGhcP p) ~ SrcSpanAnnN) =>
TyClDecl (GhcPass p) -> IdP (GhcPass p)
tcdName TyClDecl GhcRn
dat)))
            HsType GhcRn -> [HsType GhcRn] -> [HsType GhcRn]
forall a. a -> [a] -> [a]
: (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
 -> HsType GhcRn)
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)]
-> [HsType GhcRn]
forall a b. (a -> b) -> [a] -> [b]
map (HsTyVarBndr (HsBndrVis GhcRn) GhcRn -> HsType GhcRn
forall {flag}. HsTyVarBndr flag GhcRn -> HsType GhcRn
tyVarArg (HsTyVarBndr (HsBndrVis GhcRn) GhcRn -> HsType GhcRn)
-> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
    -> HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
-> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
-> HsType GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcRn) GhcRn)
-> HsTyVarBndr (HsBndrVis GhcRn) GhcRn
forall l a. GenLocated l a -> a
unLoc) (LHsQTyVars GhcRn -> [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
hsQTvExplicit (LHsQTyVars GhcRn -> [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn])
-> LHsQTyVars GhcRn -> [LHsTyVarBndr (HsBndrVis GhcRn) GhcRn]
forall a b. (a -> b) -> a -> b
$ TyClDecl GhcRn -> LHsQTyVars GhcRn
forall pass. TyClDecl pass -> LHsQTyVars pass
tyClDeclTyVars TyClDecl GhcRn
dat)
ppCtor
  SDocContext
sDocContext
  TyClDecl GhcRn
_dat
  [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs
  ( ConDeclGADT
      { con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_names = NonEmpty (LIdP GhcRn)
names
      , con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs = L SrcSpanAnnA
_ HsOuterSigTyVarBndrs GhcRn
outer_bndrs
      , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
mcxt
      , con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails GhcRn
args
      , con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = XRec GhcRn (HsType GhcRn)
res_ty
      }
    ) =
    (LocatedN Name -> [String]) -> NonEmpty (LocatedN Name) -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SDocContext
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> LocatedN Name
-> [String]
lookupCon SDocContext
sDocContext [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs) NonEmpty (LIdP GhcRn)
NonEmpty (LocatedN Name)
names [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
typeSig]
    where
      typeSig :: String
typeSig = String -> String
operator String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SDocContext -> HsSigType GhcRn -> String
outHsSigType SDocContext
sDocContext HsSigType GhcRn
con_sig_ty
      name :: String
name = SDocContext -> NonEmpty Name -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext (NonEmpty Name -> String) -> NonEmpty Name -> String
forall a b. (a -> b) -> a -> b
$ LocatedN Name -> Name
forall l a. GenLocated l a -> a
unL (LocatedN Name -> Name)
-> NonEmpty (LocatedN Name) -> NonEmpty Name
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (LIdP GhcRn)
NonEmpty (LocatedN Name)
names
      con_sig_ty :: HsSigType GhcRn
con_sig_ty = XHsSig GhcRn
-> HsOuterSigTyVarBndrs GhcRn
-> XRec GhcRn (HsType GhcRn)
-> HsSigType GhcRn
forall pass.
XHsSig pass
-> HsOuterSigTyVarBndrs pass -> LHsType pass -> HsSigType pass
HsSig XHsSig GhcRn
NoExtField
noExtField HsOuterSigTyVarBndrs GhcRn
outer_bndrs XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
theta_ty
        where
          theta_ty :: GenLocated SrcSpanAnnA (HsType GhcRn)
theta_ty = case Maybe (LHsContext GhcRn)
mcxt of
            Just LHsContext GhcRn
theta -> HsType GhcRn -> GenLocated SrcSpanAnnA (HsType GhcRn)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (HsQualTy{hst_xqual :: XQualTy GhcRn
hst_xqual = XQualTy GhcRn
NoExtField
noExtField, hst_ctxt :: LHsContext GhcRn
hst_ctxt = LHsContext GhcRn
theta, hst_body :: XRec GhcRn (HsType GhcRn)
hst_body = XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
tau_ty})
            Maybe (LHsContext GhcRn)
Nothing -> GenLocated SrcSpanAnnA (HsType GhcRn)
tau_ty
          tau_ty :: GenLocated SrcSpanAnnA (HsType GhcRn)
tau_ty = (XRec GhcRn (HsType GhcRn)
 -> GenLocated SrcSpanAnnA (HsType GhcRn)
 -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> GenLocated SrcSpanAnnA (HsType GhcRn)
-> [XRec GhcRn (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr XRec GhcRn (HsType GhcRn)
-> XRec GhcRn (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn)
XRec GhcRn (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn)
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall {pass} {e}.
(XFunTy pass ~ NoExtField,
 XUnrestrictedArrow (XRec pass (HsType pass)) pass ~ NoExtField,
 HasAnnotation e) =>
XRec pass (HsType pass)
-> XRec pass (HsType pass) -> GenLocated e (HsType pass)
mkFunTy XRec GhcRn (HsType GhcRn)
GenLocated SrcSpanAnnA (HsType GhcRn)
res_ty ([XRec GhcRn (HsType GhcRn)]
 -> GenLocated SrcSpanAnnA (HsType GhcRn))
-> [XRec GhcRn (HsType GhcRn)]
-> GenLocated SrcSpanAnnA (HsType GhcRn)
forall a b. (a -> b) -> a -> b
$
            case HsConDeclGADTDetails GhcRn
args of
              PrefixConGADT XPrefixConGADT GhcRn
_ [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
pos_args -> (HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
 -> XRec GhcRn (HsType GhcRn))
-> [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
-> [XRec GhcRn (HsType GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map HsScaled GhcRn (XRec GhcRn (HsType GhcRn))
-> XRec GhcRn (HsType GhcRn)
forall pass a. HsScaled pass a -> a
hsScaledThing [HsScaled GhcRn (XRec GhcRn (HsType GhcRn))]
pos_args
              RecConGADT XRecConGADT GhcRn
_ (L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
flds) -> (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
 -> XRec GhcRn (HsType GhcRn))
-> [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> [XRec GhcRn (HsType GhcRn)]
forall a b. (a -> b) -> [a] -> [b]
map (ConDeclField GhcRn -> XRec GhcRn (HsType GhcRn)
forall pass. ConDeclField pass -> LBangType pass
cd_fld_type (ConDeclField GhcRn -> XRec GhcRn (HsType GhcRn))
-> (GenLocated SrcSpanAnnA (ConDeclField GhcRn)
    -> ConDeclField GhcRn)
-> GenLocated SrcSpanAnnA (ConDeclField GhcRn)
-> XRec GhcRn (HsType GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcRn) -> ConDeclField GhcRn
forall l a. GenLocated l a -> a
unL) [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
flds
          mkFunTy :: XRec pass (HsType pass)
-> XRec pass (HsType pass) -> GenLocated e (HsType pass)
mkFunTy XRec pass (HsType pass)
a XRec pass (HsType pass)
b = HsType pass -> GenLocated e (HsType pass)
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA (XFunTy pass
-> HsArrow pass
-> XRec pass (HsType pass)
-> XRec pass (HsType pass)
-> HsType pass
forall pass.
XFunTy pass
-> HsArrow pass -> LHsType pass -> LHsType pass -> HsType pass
HsFunTy XFunTy pass
NoExtField
noExtField (XUnrestrictedArrow (XRec pass (HsType pass)) pass -> HsArrow pass
forall mult pass.
XUnrestrictedArrow mult pass -> HsArrowOf mult pass
HsUnrestrictedArrow NoExtField
XUnrestrictedArrow (XRec pass (HsType pass)) pass
noExtField) XRec pass (HsType pass)
a XRec pass (HsType pass)
b)

ppFixity :: SDocContext -> (Name, Fixity) -> [String]
ppFixity :: SDocContext -> (Name, Fixity) -> [String]
ppFixity SDocContext
sDocContext (Name
name, Fixity
fixity) = [SDocContext -> FixitySig GhcRn -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext ((XFixitySig GhcRn -> [LIdP GhcRn] -> Fixity -> FixitySig GhcRn
forall pass.
XFixitySig pass -> [LIdP pass] -> Fixity -> FixitySig pass
FixitySig XFixitySig GhcRn
NamespaceSpecifier
NoNamespaceSpecifier [Name -> LocatedN Name
forall e a. HasAnnotation e => a -> GenLocated e a
noLocA Name
name] Fixity
fixity) :: FixitySig GhcRn)]

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

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

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

mdoc :: Outputable o => SDocContext -> Maybe (MDoc o) -> [String]
mdoc :: forall o. Outputable o => SDocContext -> Maybe (MDoc o) -> [String]
mdoc SDocContext
sDocContext = SDocContext -> String -> Maybe (Doc o) -> [String]
forall o.
Outputable o =>
SDocContext -> String -> Maybe (Doc o) -> [String]
docWith SDocContext
sDocContext 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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) 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 => SDocContext -> String -> Maybe (Doc o) -> [String]
docWith :: forall o.
Outputable o =>
SDocContext -> String -> Maybe (Doc o) -> [String]
docWith SDocContext
_ [] Maybe (Doc o)
Nothing = []
docWith SDocContext
sDocContext 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 (SDocContext
-> DocMarkupH (Wrap (ModuleName, OccName)) (Wrap o) [Tag]
forall o. Outputable o => SDocContext -> DocMarkup o [Tag]
markupTag SDocContext
sDocContext)) Maybe (Doc o)
d

mkSubdocN :: SDocContext -> LocatedN Name -> [(Name, DocForDecl Name)] -> [String] -> [String]
mkSubdocN :: SDocContext
-> LocatedN Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdocN SDocContext
sDocContext LocatedN Name
n [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs [String]
s = SDocContext
-> LocatedA Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdoc SDocContext
sDocContext (LocatedN Name -> LocatedA Name
forall l l2 a.
(HasLoc l, HasAnnotation l2) =>
GenLocated l a -> GenLocated l2 a
la2la LocatedN Name
n) [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs [String]
s

mkSubdoc :: SDocContext -> LocatedA Name -> [(Name, DocForDecl Name)] -> [String] -> [String]
mkSubdoc :: SDocContext
-> LocatedA Name
-> [(Name, (Documentation Name, FnArgsDoc Name))]
-> [String]
-> [String]
mkSubdoc SDocContext
sDocContext LocatedA Name
n [(Name, (Documentation Name, FnArgsDoc Name))]
subdocs [String]
s = (Documentation Name -> [String])
-> [Documentation Name] -> [String]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap (SDocContext -> Documentation Name -> [String]
forall o.
Outputable o =>
SDocContext -> Documentation o -> [String]
ppDocumentation SDocContext
sDocContext) [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 a. a -> [a]
forall (m :: Type -> Type) 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 (LocatedA Name -> Name
forall l a. GenLocated l a -> a
unLoc LocatedA 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
$cshowsPrec :: Int -> Tag -> String -> String
showsPrec :: Int -> Tag -> String -> String
$cshow :: Tag -> String
show :: Tag -> String
$cshowList :: [Tag] -> String -> String
showList :: [Tag] -> String -> String
Show)

type Tags = [Tag]

box :: (a -> b) -> a -> [b]
box :: forall a b. (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 => SDocContext -> DocMarkup o [Tag]
markupTag :: forall o. Outputable o => SDocContext -> DocMarkup o [Tag]
markupTag SDocContext
sDocContext =
  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
. SDocContext -> o -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext
    , 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 (SDocContext -> OccName -> String
forall a. Outputable a => SDocContext -> a -> String
out SDocContext
sDocContext (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 :: [(Int, [Tag])] -> [Tag]
markupOrderedList = ([[Tag]] -> Tag) -> [[Tag]] -> [Tag]
forall a b. (a -> b) -> a -> [b]
box (Char -> [[Tag]] -> Tag
TagL Char
'o') ([[Tag]] -> [Tag])
-> ([(Int, [Tag])] -> [[Tag]]) -> [(Int, [Tag])] -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [Tag]) -> [Tag]) -> [(Int, [Tag])] -> [[Tag]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [Tag]) -> [Tag]
forall a b. (a, b) -> b
snd
    , 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
t Char -> 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
t Char -> String -> String
forall a. a -> [a] -> [a]
: String
"l>"]
  where
    mid :: [String]
mid = ([Tag] -> [String]) -> [[Tag]] -> [String]
forall (t :: Type -> Type) 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
t Char -> 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 :: Type -> Type) a b.
Foldable t =>
(a -> [b]) -> t a -> [b]
concatMap Tag -> String
f
  where
    fs :: [Tag] -> String
fs = (Tag -> String) -> [Tag] -> String
forall (t :: Type -> Type) 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
s String -> 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
s String -> 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 :: Type -> Type) 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 a. [a] -> Bool
forall (t :: Type -> Type) 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 a. [a] -> Bool
forall (t :: Type -> Type) 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 a. [a] -> Int
forall (t :: Type -> Type) 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 a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [Int]
ns then Int
0 else [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
ns

    fs :: [Tag] -> String
fs = (Tag -> String) -> [Tag] -> String
forall (t :: Type -> Type) 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
s String -> 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
s String -> 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
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
s) [String]
xs
      where
        nx :: Int
nx = String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) 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 :: Type -> Type) 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 a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SDoc -> SDoc -> SDoc
($+$) SDoc
forall doc. IsOutput doc => doc
empty