module Haddock.Types (
module Haddock.Types
#if __GLASGOW_HASKELL__ >= 611
, HsDocString, LHsDocString
#else
, HsDoc(..), LHsDoc, HaddockModInfo(..), emptyHaddockModInfo
#endif
) where
import Control.Exception
import Data.Typeable
import Data.Map (Map)
import qualified Data.Map as Map
import GHC hiding (NoLink)
import Name
type Decl = LHsDecl Name
type Doc = HsDoc Name
#if __GLASGOW_HASKELL__ <= 610
type HsDocString = HsDoc Name
type LHsDocString = Located HsDocString
#endif
type FnArgsDoc name = Map Int (HsDoc name)
type DocForDecl name = (Maybe (HsDoc name), FnArgsDoc name)
noDocForDecl :: DocForDecl name
noDocForDecl = (Nothing, Map.empty)
type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)])
data DocName = Documented Name Module | Undocumented Name
deriving Eq
docNameOcc :: DocName -> OccName
docNameOcc = nameOccName . getName
instance NamedThing DocName where
getName (Documented name _) = name
getName (Undocumented name) = name
data DocOption
= OptHide
| OptPrune
| OptIgnoreExports
| OptNotHome
deriving (Eq, Show)
data ExportItem name
= ExportDecl {
expItemDecl :: LHsDecl name,
expItemMbDoc :: DocForDecl name,
expItemSubDocs :: [(name, DocForDecl name)],
expItemInstances :: [InstHead name]
}
| ExportNoDecl {
expItemName :: name,
expItemSubs :: [name]
}
| ExportGroup {
expItemSectionLevel :: Int,
expItemSectionId :: String,
expItemSectionText :: HsDoc name
}
| ExportDoc (HsDoc name)
| ExportModule Module
type InstHead name = ([HsPred name], name, [HsType name])
type ModuleMap = Map Module Interface
type InstIfaceMap = Map Module InstalledInterface
type DocMap = Map Name (HsDoc DocName)
type LinkEnv = Map Name Module
#if __GLASGOW_HASKELL__ >= 611
type GhcDocHdr = Maybe LHsDocString
#else
type GhcDocHdr = (HaddockModInfo Name, Maybe (HsDoc Name))
#endif
data GhcModule = GhcModule {
ghcModule :: Module,
ghcFilename :: FilePath,
ghcMbDocOpts :: Maybe String,
ghcMbDocHdr :: GhcDocHdr,
ghcGroup :: HsGroup Name,
ghcMbExports :: Maybe [LIE Name],
ghcExportedNames :: [Name],
ghcDefinedNames :: [Name],
ghcNamesInScope :: [Name],
ghcInstances :: [Instance]
}
data Interface = Interface {
ifaceMod :: Module,
ifaceOrigFilename :: FilePath,
ifaceInfo :: !(HaddockModInfo Name),
ifaceDoc :: !(Maybe (HsDoc Name)),
ifaceRnDoc :: Maybe (HsDoc DocName),
ifaceOptions :: ![DocOption],
ifaceDeclMap :: Map Name DeclInfo,
ifaceRnDocMap :: Map Name (DocForDecl DocName),
ifaceSubMap :: Map Name [Name],
ifaceExportItems :: ![ExportItem Name],
ifaceRnExportItems :: [ExportItem DocName],
ifaceLocals :: ![Name],
ifaceExports :: ![Name],
ifaceVisibleExports :: ![Name],
ifaceInstances :: ![Instance]
}
data InstalledInterface = InstalledInterface {
instMod :: Module,
instInfo :: HaddockModInfo Name,
instDocMap :: Map Name (DocForDecl Name),
instExports :: [Name],
instVisibleExports :: [Name],
instOptions :: [DocOption],
instSubMap :: Map Name [Name]
}
toInstalledIface :: Interface -> InstalledInterface
toInstalledIface interface = InstalledInterface {
instMod = ifaceMod interface,
instInfo = ifaceInfo interface,
instDocMap = fmap unrenameDocForDecl $ ifaceRnDocMap interface,
instExports = ifaceExports interface,
instVisibleExports = ifaceVisibleExports interface,
instOptions = ifaceOptions interface,
instSubMap = ifaceSubMap interface
}
unrenameHsDoc :: HsDoc DocName -> HsDoc Name
unrenameHsDoc = fmapHsDoc getName
unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
unrenameDocForDecl (mbDoc, fnArgsDoc) =
(fmap unrenameHsDoc mbDoc, fmap unrenameHsDoc fnArgsDoc)
#if __GLASGOW_HASKELL__ >= 611
data HsDoc id
= DocEmpty
| DocAppend (HsDoc id) (HsDoc id)
| DocString String
| DocParagraph (HsDoc id)
| DocIdentifier [id]
| DocModule String
| DocEmphasis (HsDoc id)
| DocMonospaced (HsDoc id)
| DocUnorderedList [HsDoc id]
| DocOrderedList [HsDoc id]
| DocDefList [(HsDoc id, HsDoc id)]
| DocCodeBlock (HsDoc id)
| DocURL String
| DocPic String
| DocAName String
deriving (Eq, Show)
type LHsDoc id = Located (HsDoc id)
#endif
data DocMarkup id a = Markup {
markupEmpty :: a,
markupString :: String -> a,
markupParagraph :: a -> a,
markupAppend :: a -> a -> a,
markupIdentifier :: [id] -> a,
markupModule :: String -> a,
markupEmphasis :: a -> a,
markupMonospaced :: a -> a,
markupUnorderedList :: [a] -> a,
markupOrderedList :: [a] -> a,
markupDefList :: [(a,a)] -> a,
markupCodeBlock :: a -> a,
markupURL :: String -> a,
markupAName :: String -> a,
markupPic :: String -> a
}
#if __GLASGOW_HASKELL__ >= 611
data HaddockModInfo name = HaddockModInfo {
hmi_description :: Maybe (HsDoc name),
hmi_portability :: Maybe String,
hmi_stability :: Maybe String,
hmi_maintainer :: Maybe String
}
emptyHaddockModInfo :: HaddockModInfo a
emptyHaddockModInfo = HaddockModInfo {
hmi_description = Nothing,
hmi_portability = Nothing,
hmi_stability = Nothing,
hmi_maintainer = Nothing
}
#endif
type ErrMsg = String
newtype ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) }
instance Functor ErrMsgM where
fmap f (Writer (a, msgs)) = Writer (f a, msgs)
instance Monad ErrMsgM where
return a = Writer (a, [])
m >>= k = Writer $ let
(a, w) = runWriter m
(b, w') = runWriter (k a)
in (b, w ++ w')
tell :: [ErrMsg] -> ErrMsgM ()
tell w = Writer ((), w)
data HaddockException = HaddockException String deriving Typeable
instance Show HaddockException where
show (HaddockException str) = str
throwE :: String -> a
instance Exception HaddockException
throwE str = throw (HaddockException str)
newtype ErrMsgGhc a = WriterGhc { runWriterGhc :: (Ghc (a, [ErrMsg])) }
liftGhcToErrMsgGhc :: Ghc a -> ErrMsgGhc a
liftGhcToErrMsgGhc = WriterGhc . fmap (\a->(a,[]))
liftErrMsg :: ErrMsgM a -> ErrMsgGhc a
liftErrMsg = WriterGhc . return . runWriter
instance Functor ErrMsgGhc where
fmap f (WriterGhc x) = WriterGhc (fmap (\(a,msgs)->(f a,msgs)) x)
instance Monad ErrMsgGhc where
return a = WriterGhc (return (a, []))
m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
fmap (\ (b, msgs2) -> (b, msgs1 ++ msgs2)) (runWriterGhc (k a))
fmapHsDoc :: (a->b) -> HsDoc a -> HsDoc b
fmapHsDoc _ DocEmpty = DocEmpty
fmapHsDoc f (DocAppend a b) = DocAppend (fmapHsDoc f a) (fmapHsDoc f b)
fmapHsDoc _ (DocString s) = DocString s
fmapHsDoc _ (DocModule s) = DocModule s
fmapHsDoc _ (DocURL s) = DocURL s
fmapHsDoc _ (DocPic s) = DocPic s
fmapHsDoc _ (DocAName s) = DocAName s
fmapHsDoc f (DocParagraph a) = DocParagraph (fmapHsDoc f a)
fmapHsDoc f (DocEmphasis a) = DocEmphasis (fmapHsDoc f a)
fmapHsDoc f (DocMonospaced a) = DocMonospaced (fmapHsDoc f a)
fmapHsDoc f (DocCodeBlock a) = DocMonospaced (fmapHsDoc f a)
fmapHsDoc f (DocIdentifier a) = DocIdentifier (map f a)
fmapHsDoc f (DocOrderedList a) = DocOrderedList (map (fmapHsDoc f) a)
fmapHsDoc f (DocUnorderedList a) = DocUnorderedList (map (fmapHsDoc f) a)
fmapHsDoc f (DocDefList a) = DocDefList (map (\(b,c)->(fmapHsDoc f b, fmapHsDoc f c)) a)