diff options
| -rw-r--r-- | src/Haddock/Types.hs | 30 |
1 files changed, 23 insertions, 7 deletions
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 5c57986c..50e0c542 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -14,7 +14,6 @@ -- 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 @@ -33,6 +32,7 @@ import Name import Test.QuickCheck #endif + -- convenient short-hands type Decl = LHsDecl Name @@ -46,9 +46,11 @@ 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) + -- | A declaration that may have documentation, including its subordinates, -- which may also have documentation type DeclInfo = (Decl, DocForDecl Name, [(Name, DocForDecl Name)]) @@ -136,7 +138,6 @@ type InstHead name = ([HsPred name], name, [HsType name]) type IfaceMap = Map Module Interface type InstIfaceMap = Map Module InstalledInterface type DocMap = Map Name (Doc DocName) - -- | An environment used to create hyper-linked syntax. type LinkEnv = Map Name Module @@ -256,8 +257,11 @@ toInstalledIface interface = InstalledInterface { 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) @@ -282,15 +286,18 @@ data Doc id | DocExamples [Example] deriving (Eq, Show, Functor) -data Example = Example { exampleExpression :: String - , exampleResult :: [String] - } - deriving (Eq, Show) + +data Example = Example + { exampleExpression :: String + , exampleResult :: [String] + } deriving (Eq, Show) + exampleToString :: Example -> String exampleToString (Example expression result) = "ghci> " ++ expression ++ "\n" ++ unlines result + #ifdef TEST -- TODO: use derive instance Arbitrary a => Arbitrary (Doc a) where @@ -355,13 +362,15 @@ emptyHaddockModInfo = HaddockModInfo { -- A monad which collects error messages, locally defined to avoid a dep on mtl -type ErrMsg = String +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 @@ -369,12 +378,14 @@ instance Monad ErrMsgM where (b, w') = runWriter (k a) in (b, w ++ w') + tell :: [ErrMsg] -> ErrMsgM () tell w = Writer ((), w) -- Exceptions + -- | Haddock's own exception type data HaddockException = HaddockException String deriving Typeable @@ -387,6 +398,7 @@ throwE :: String -> a instance Exception HaddockException throwE str = throw (HaddockException str) + -- 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 @@ -403,8 +415,12 @@ liftErrMsg = WriterGhc . return . runWriter -- for now, use (liftErrMsg . tell) for this --tell :: [ErrMsg] -> ErrMsgGhc () --tell msgs = WriterGhc $ return ( (), msgs ) + + 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) -> |