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
#ifdef TEST
import Test.QuickCheck
#endif
type Decl = LHsDecl Name
type DocInstance name = (InstHead name, Maybe (Doc name))
type FnArgsDoc name = Map Int (Doc name)
type DocForDecl name = (Maybe (Doc 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 :: [DocInstance name]
}
| ExportNoDecl {
expItemName :: name,
expItemSubs :: [name]
}
| ExportGroup {
expItemSectionLevel :: Int,
expItemSectionId :: String,
expItemSectionText :: Doc name
}
| ExportDoc (Doc 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 (Doc DocName)
type LinkEnv = Map Name Module
type GhcDocHdr = Maybe LHsDocString
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 (Doc Name)),
ifaceRnDoc :: Maybe (Doc DocName),
ifaceOptions :: ![DocOption],
ifaceDeclMap :: Map Name DeclInfo,
ifaceRnDocMap :: Map Name (DocForDecl DocName),
ifaceSubMap :: Map Name [Name],
ifaceExportItems :: ![ExportItem Name],
ifaceRnExportItems :: [ExportItem DocName],
ifaceExports :: ![Name],
ifaceVisibleExports :: ![Name],
ifaceInstances :: ![Instance],
ifaceInstanceDocMap :: Map Name (Doc Name)
}
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
}
unrenameDoc :: Doc DocName -> Doc Name
unrenameDoc = fmap getName
unrenameDocForDecl :: DocForDecl DocName -> DocForDecl Name
unrenameDocForDecl (mbDoc, fnArgsDoc) =
(fmap unrenameDoc mbDoc, fmap unrenameDoc fnArgsDoc)
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
deriving (Eq, Show, Functor)
#ifdef TEST
instance Arbitrary a => Arbitrary (Doc a) where
arbitrary =
oneof [ return DocEmpty
, do { a <- arbitrary; b <- arbitrary; return (DocAppend a b) }
, fmap DocString arbitrary
, fmap DocParagraph arbitrary
, fmap DocIdentifier arbitrary
, fmap DocModule arbitrary
, fmap DocEmphasis arbitrary
, fmap DocMonospaced arbitrary
, fmap DocUnorderedList arbitrary
, fmap DocOrderedList arbitrary
, fmap DocDefList arbitrary
, fmap DocCodeBlock arbitrary
, fmap DocURL arbitrary
, fmap DocPic arbitrary
, fmap DocAName arbitrary ]
#endif
type LDoc id = Located (Doc id)
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
}
data 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,
hmi_portability = Nothing,
hmi_stability = Nothing,
hmi_maintainer = Nothing
}
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 (first f) x)
instance Monad ErrMsgGhc where
return a = WriterGhc (return (a, []))
m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
fmap (second (msgs1 ++)) (runWriterGhc (k a))