{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Haddock.Types
-- Copyright   :  (c) Simon Marlow 2003-2006,
--                    David Waern  2006-2009
-- License     :  BSD-like
--
-- Maintainer  :  haddock@projects.haskellorg
-- Stability   :  experimental
-- Portability :  portable
--
-- Types that are commonly used through-out Haddock. Some of the most
-- important types are defined here, like 'Interface' and 'DocName'.
-----------------------------------------------------------------------------
module Haddock.Types (
  module Haddock.Types
  , HsDocString, LHsDocString
 ) where


import Control.Exception
import Control.Arrow
import Data.Typeable
import Data.Map (Map)
import qualified Data.Map as Map
import GHC hiding (NoLink)
import Name


-----------------------------------------------------------------------------
-- * Convenient synonyms
-----------------------------------------------------------------------------


type IfaceMap      = Map Module Interface
type InstIfaceMap  = Map Module InstalledInterface
type DocMap        = Map Name (Doc DocName)
type SrcMap        = Map PackageId FilePath
type Decl          = LHsDecl Name
type GhcDocHdr     = Maybe LHsDocString
type DocPaths      = (FilePath, Maybe FilePath) -- paths to HTML and sources


-----------------------------------------------------------------------------
-- * Interface
-----------------------------------------------------------------------------


-- | 'Interface' holds all information used to render a single Haddock page.
-- It represents the /interface/ of a module. The core business of Haddock
-- lies in creating this structure. Note that the record contains some fields
-- that are only used to create the final record, and that are not used by the
-- backends.
data ifaceRnDocMap :: Map Name (DocForDecl DocName)Interface = Interface
  {
    -- | The module behind this interface.
    ifaceMod             :: Module

    -- | Original file name of the module.
  , ifaceOrigFilename    :: FilePath

    -- | Textual information about the module.
  , ifaceInfo            :: !(HaddockModInfo Name)

    -- | Documentation header.
  , ifaceDoc             :: !(Maybe (Doc Name))

    -- | Documentation header with cross-reference information.
  , ifaceRnDoc           :: Maybe (Doc DocName)

    -- | Haddock options for this module (prune, ignore-exports, etc).
  , ifaceOptions         :: ![DocOption]

    -- | Declarations originating from the module. Excludes declarations without
    -- names (instances and stand-alone documentation comments). Includes
    -- names of subordinate declarations mapped to their parent declarations.
  , ifaceDeclMap         :: Map Name DeclInfo

    -- | Documentation of declarations originating from the module (including
    -- subordinates).
  , ifaceRnDocMap        :: Map Name (DocForDecl DocName)

  , ifaceSubMap          :: Map Name [Name]

  , ifaceExportItems     :: ![ExportItem Name]
  , ifaceRnExportItems   :: [ExportItem DocName]

    -- | All names exported by the module.
  , ifaceExports         :: ![Name]

    -- | All \"visible\" names exported by the module.
    -- A visible name is a name that will show up in the documentation of the
    -- module.
  , ifaceVisibleExports  :: ![Name]

    -- | Instances exported by the module.
  , ifaceInstances       :: ![Instance]

    -- | Documentation of instances defined in the module.
  , ifaceInstanceDocMap  :: Map Name (Doc Name)

    -- | The number of haddockable and haddocked items in the module, as a
    -- tuple. Haddockable items are the exports and the module itself.
  , ifaceHaddockCoverage  :: (Int,Int)
    
    -- | The actual typechecked source, used to generate mouseover annotations.
  , ifaceTcSource        :: TypecheckedSource
  }


-- | A subset of the fields of 'Interface' that we store in the interface
-- files.
data instDocMap :: Map Name (DocForDecl Name)InstalledInterface = InstalledInterface
  {
    -- | The module represented by this interface.
    instMod            :: Module

    -- | Textual information about the module.
  , instInfo           :: HaddockModInfo Name

    -- | Documentation of declarations originating from the module (including
    -- subordinates).
  , instDocMap         :: Map Name (DocForDecl Name)

    -- | All names exported by this module.
  , instExports        :: [Name]

    -- | All \"visible\" names exported by the module.
    -- A visible name is a name that will show up in the documentation of the
    -- module.
  , instVisibleExports :: [Name]

    -- | Haddock options for this module (prune, ignore-exports, etc).
  , instOptions        :: [DocOption]

  , instSubMap         :: Map Name [Name]
  }


-- | Convert an 'Interface' to an 'InstalledInterface'
toInstalledIface :: Interface -> InstalledInterface
toInstalledIface interface = InstalledInterface
  { instMod            = ifaceMod :: Interface -> ModuleifaceMod            interface :: Interfaceinterface
  , instInfo           = ifaceInfo :: Interface -> HaddockModInfo NameifaceInfo           interface :: Interfaceinterface
  , instDocMap         = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap unrenameDocForDecl :: DocForDecl DocName -> DocForDecl NameunrenameDocForDecl ($) :: (a -> b) -> a -> b$ ifaceRnDocMap :: Interface -> Map Name (DocForDecl DocName)ifaceRnDocMap interface :: Interfaceinterface
  , instExports        = ifaceExports :: Interface -> [Name]ifaceExports        interface :: Interfaceinterface
  , instVisibleExports = ifaceVisibleExports :: Interface -> [Name]ifaceVisibleExports interface :: Interfaceinterface
  , instOptions        = ifaceOptions :: Interface -> [DocOption]ifaceOptions        interface :: Interfaceinterface
  , instSubMap         = ifaceSubMap :: Interface -> Map Name [Name]ifaceSubMap         interface :: Interfaceinterface
  }


-----------------------------------------------------------------------------
-- * Export items & declarations
-----------------------------------------------------------------------------


data expItemSubDocs :: [(name, DocForDecl name)]ExportItem name

  -- | An exported declaration.
  = ExportDecl
      {
        -- | A declaration.
        expItemDecl :: LHsDecl name

        -- | Maybe a doc comment, and possibly docs for arguments (if this
        -- decl is a function or type-synonym).
      , expItemMbDoc :: DocForDecl name

        -- | Subordinate names, possibly with documentation.
      , expItemSubDocs :: [(name, DocForDecl name)]

        -- | Instances relevant to this declaration, possibly with
        -- documentation.
      , expItemInstances :: [DocInstance name]
      }

  -- | An exported entity for which we have no documentation (perhaps because it
  -- resides in another package).
  | ExportNoDecl
      { expItemName :: name

        -- | Subordinate names.
      , expItemSubs :: [name]
      }

  -- | A section heading. 
  | ExportGroup
      {
        -- | Section level (1, 2, 3, ...).
        expItemSectionLevel :: Int

        -- | Section id (for hyperlinks).
      , expItemSectionId :: String

        -- | Section heading text.
      , expItemSectionText :: Doc name
      }

  -- | Some documentation.
  | ExportDoc (Doc name)

  -- | A cross-reference to another module.
  | ExportModule Module


-- | A declaration that may have documentation, including its subordinates,
-- which may also have documentation.
type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)])


-- | Arguments and result are indexed by Int, zero-based from the left,
-- because that's the easiest to use when recursing over types.
type FnArgsDoc name = Map Int (Doc name)
type DocForDecl name = (Maybe (Doc name), FnArgsDoc name)


noDocForDecl :: DocForDecl name
noDocForDecl = (Nothing :: Maybe aNothing, empty :: Map k aMap.empty)


unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
unrenameDocForDecl (mbDoc, fnArgsDoc) =
    (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap unrenameDoc :: Doc DocName -> Doc NameunrenameDoc mbDoc :: Maybe (Doc DocName)mbDoc, fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap unrenameDoc :: Doc DocName -> Doc NameunrenameDoc fnArgsDoc :: FnArgsDoc DocNamefnArgsDoc)


-----------------------------------------------------------------------------
-- * Cross-referencing
-----------------------------------------------------------------------------


-- | Type of environment used to cross-reference identifiers in the syntax.
type LinkEnv = Map Name Module


-- | Extends 'Name' with cross-reference information.
data DocName
  = Documented Name Module
     -- ^ This thing is part of the (existing or resulting)
     -- documentation. The 'Module' is the preferred place
     -- in the documentation to refer to.
  | Undocumented Name
     -- ^ This thing is not part of the (existing or resulting)
     -- documentation, as far as Haddock knows.
  deriving D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq


instance D:NamedThing :: (a -> OccName) -> (a -> Name) -> T:NamedThing aNamedThing DocName where
  getName (Documented name _) = name :: Namename
  getName (Undocumented name) = name :: Namename


-----------------------------------------------------------------------------
-- * Instances
-----------------------------------------------------------------------------


-- | An instance head that may have documentation.
type DocInstance name = (InstHead name, Maybe (Doc name))


-- | The head of an instance. Consists of a context, a class name and a list
-- of instance types.
type InstHead name = ([HsPred name], name, [HsType name])


-----------------------------------------------------------------------------
-- * Documentation comments
-----------------------------------------------------------------------------


type LDoc id = Located (Doc id)


data Doc id
  = DocEmpty
  | DocAppend (Doc id) (Doc id)
  | DocString String
  | DocParagraph (Doc id)
  | DocIdentifier [id]
  | DocModule String
  | DocEmphasis (Doc id)
  | DocMonospaced (Doc id)
  | DocUnorderedList [Doc id]
  | DocOrderedList [Doc id]
  | DocDefList [(Doc id, Doc id)]
  | DocCodeBlock (Doc id)
  | DocURL String
  | DocPic String
  | DocAName String
  | DocExamples [Example]
  deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq, D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow, D:Functor ::
  (forall a b. (a -> b) -> f a -> f b)
  -> (forall a b. a -> f b -> f a)
  -> T:Functor fFunctor)


unrenameDoc :: Doc DocName -> Doc Name
unrenameDoc = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap getName :: NamedThing a => a -> NamegetName


data exampleExpression :: StringExample = Example
  { exampleExpression :: String
  , exampleResult     :: [String]
  } deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq, D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow)


exampleToString :: Example -> String
exampleToString (Example expression result) =
    ">>> " (++) :: [a] -> [a] -> [a]++ expression :: Stringexpression (++) :: [a] -> [a] -> [a]++ "\n" (++) :: [a] -> [a] -> [a]++  unlines :: [String] -> Stringunlines result :: [String]result


data markupUnorderedList :: [a] -> aDocMarkup 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
  , markupExample       :: [Example] -> a
  }


data hmi_description :: Maybe (Doc name)HaddockModInfo name = HaddockModInfo
  { hmi_description :: Maybe (Doc name)
  , hmi_portability :: Maybe String
  , hmi_stability   :: Maybe String
  , hmi_maintainer  :: Maybe String
  }


emptyHaddockModInfo :: HaddockModInfo a
emptyHaddockModInfo = HaddockModInfo
  { hmi_description = Nothing :: Maybe aNothing
  , hmi_portability = Nothing :: Maybe aNothing
  , hmi_stability   = Nothing :: Maybe aNothing
  , hmi_maintainer  = Nothing :: Maybe aNothing
  }


-----------------------------------------------------------------------------
-- * Options
-----------------------------------------------------------------------------


{-! for DocOption derive: Binary !-}
-- | Source-level options for controlling the documentation.
data DocOption
  = OptHide            -- ^ This module should not appear in the docs.
  | OptPrune
  | OptIgnoreExports   -- ^ Pretend everything is exported.
  | OptNotHome         -- ^ Not the best place to get docs for things
                       -- exported by this module.
  deriving (D:Eq :: (a -> a -> Bool) -> (a -> a -> Bool) -> T:Eq aEq, D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow)


-- | Option controlling how to qualify names
data Qualification
  = NoQual                       -- ^ Never qualify any names.
  | FullQual                     -- ^ Qualify all names fully.
  | LocalQual (Maybe Module)     -- ^ Qualify all imported names fully.
  | RelativeQual (Maybe Module)  -- ^ Like local, but strip module prefix.
                                 --   from modules in the same hierarchy.


-----------------------------------------------------------------------------
-- * Error handling
-----------------------------------------------------------------------------


-- A monad which collects error messages, locally defined to avoid a dep on mtl


type ErrMsg = String
newtype runWriter :: (a, [ErrMsg])ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) }


instance D:Functor ::
  (forall a b. (a -> b) -> f a -> f b)
  -> (forall a b. a -> f b -> f a)
  -> T:Functor fFunctor ErrMsgM where
        fmap f (Writer (a, msgs)) = Writer :: (a, [ErrMsg]) -> ErrMsgM aWriter (f :: a -> bf a :: aa, msgs :: [ErrMsg]msgs)


instance D:Monad ::
  (forall a b. m a -> (a -> m b) -> m b)
  -> (forall a b. m a -> m b -> m b)
  -> (forall a. a -> m a)
  -> (forall a. String -> m a)
  -> T:Monad mMonad ErrMsgM where
        return a = Writer :: (a, [ErrMsg]) -> ErrMsgM aWriter (a :: aa, [] :: [a][])
        m >>= k  = Writer :: (a, [ErrMsg]) -> ErrMsgM aWriter ($) :: (a -> b) -> a -> b$ let
                (a, w)  = runWriter :: ErrMsgM a -> (a, [ErrMsg])runWriter m :: ErrMsgM am
                (b, w') = runWriter :: ErrMsgM a -> (a, [ErrMsg])runWriter (k :: a -> ErrMsgM bk a :: aa)
                in (b :: bb, w :: [ErrMsg]w (++) :: [a] -> [a] -> [a]++ w' :: [ErrMsg]w')


tell :: [ErrMsg] -> ErrMsgM ()
tell w = Writer :: (a, [ErrMsg]) -> ErrMsgM aWriter ((), w :: [ErrMsg]w)


-- Exceptions


-- | Haddock's own exception type.
data HaddockException = HaddockException String deriving D:Typeable :: (a -> TypeRep) -> T:Typeable aTypeable


instance D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow HaddockException where
  show (HaddockException str) = str :: Stringstr


throwE :: String -> a
instance D:Exception ::
  (Typeable e, Show e) =>
  (e -> SomeException) -> (SomeException -> Maybe e) -> T:Exception eException HaddockException
throwE str = throw :: Exception e => e -> athrow (HaddockException :: String -> HaddockExceptionHaddockException str :: Stringstr)


-- In "Haddock.Interface.Create", we need to gather
-- @Haddock.Types.ErrMsg@s a lot, like @ErrMsgM@ does,
-- but we can't just use @GhcT ErrMsgM@ because GhcT requires the
-- transformed monad to be MonadIO.
newtype runWriterGhc :: Ghc (a, [ErrMsg])ErrMsgGhc a = WriterGhc { runWriterGhc :: (Ghc (a, [ErrMsg])) }
--instance MonadIO ErrMsgGhc where
--  liftIO = WriterGhc . fmap (\a->(a,[])) liftIO
--er, implementing GhcMonad involves annoying ExceptionMonad and
--WarnLogMonad classes, so don't bother.
liftGhcToErrMsgGhc :: Ghc a -> ErrMsgGhc a
liftGhcToErrMsgGhc = WriterGhc :: Ghc (a, [ErrMsg]) -> ErrMsgGhc aWriterGhc (.) :: (b -> c) -> (a -> b) -> a -> c. fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (\a->(a :: aa,[] :: [a][]))
liftErrMsg :: ErrMsgM a -> ErrMsgGhc a
liftErrMsg = WriterGhc :: Ghc (a, [ErrMsg]) -> ErrMsgGhc aWriterGhc (.) :: (b -> c) -> (a -> b) -> a -> c. return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. runWriter :: ErrMsgM a -> (a, [ErrMsg])runWriter
--  for now, use (liftErrMsg . tell) for this
--tell :: [ErrMsg] -> ErrMsgGhc ()
--tell msgs = WriterGhc $ return ( (), msgs )


instance D:Functor ::
  (forall a b. (a -> b) -> f a -> f b)
  -> (forall a b. a -> f b -> f a)
  -> T:Functor fFunctor ErrMsgGhc where
  fmap f (WriterGhc x) = WriterGhc :: Ghc (a, [ErrMsg]) -> ErrMsgGhc aWriterGhc (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (first :: Arrow a => forall b c d. a b c -> a (b, d) (c, d)first f :: a -> bf) x :: Ghc (a, [ErrMsg])x)


instance D:Monad ::
  (forall a b. m a -> (a -> m b) -> m b)
  -> (forall a b. m a -> m b -> m b)
  -> (forall a. a -> m a)
  -> (forall a. String -> m a)
  -> T:Monad mMonad ErrMsgGhc where
  return a = WriterGhc :: Ghc (a, [ErrMsg]) -> ErrMsgGhc aWriterGhc (return :: Monad m => forall a. a -> m areturn (a :: aa, [] :: [a][]))
  m >>= k = WriterGhc :: Ghc (a, [ErrMsg]) -> ErrMsgGhc aWriterGhc ($) :: (a -> b) -> a -> b$ runWriterGhc :: ErrMsgGhc a -> Ghc (a, [ErrMsg])runWriterGhc m :: ErrMsgM am (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= \ (a, msgs1) ->
               fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (second :: Arrow a => forall b c d. a b c -> a (d, b) (d, c)second (msgs1 :: [ErrMsg]msgs1 (++) :: [a] -> [a] -> [a]++)) (runWriterGhc :: ErrMsgGhc a -> Ghc (a, [ErrMsg])runWriterGhc (k :: a -> ErrMsgM bk a :: aa))