module Haskell.Docs.Formatting where
import Haskell.Docs.Types
import Haskell.Docs.Ghc
import Haskell.Docs.HaddockDoc
import Control.Monad
import Data.Char
import Data.List
import Documentation.Haddock
import GHC hiding (verbosity)
import GhcMonad (liftIO)
import Name
printSexp :: [IdentDoc] -> Ghc ()
printSexp = mapM toSexp >=> liftIO . putStrLn . renderSexp . List
printIdentDoc :: Bool
-> Bool
-> Bool
-> IdentDoc
-> Ghc ()
printIdentDoc True _ _ idoc =
do d <- getSessionDynFlags
maybe (liftIO (putStrLn (showppr d (identDocModuleName idoc))))
(\i -> liftIO (putStrLn (showppr d (moduleName (nameModule (getName i))))))
(identDocIdent idoc)
printIdentDoc _ printPkg printModule idoc =
do d <- getSessionDynFlags
when printPkg
(liftIO (putStrLn ("Package: " ++ showPackageName (identDocPackageName idoc))))
when printModule
(maybe (liftIO (putStrLn ("Module: " ++ showppr d (identDocModuleName idoc))))
(\i -> liftIO (putStrLn ("Module: " ++
showppr d (moduleName (nameModule (getName i))))))
(identDocIdent idoc))
case identDocIdent idoc of
Nothing -> liftIO (putStrLn (unIdentifier (identDocIdentifier idoc)))
Just i -> liftIO (putStrLn (showppr d i ++ " :: " ++ showppr d (idType i)))
liftIO (putStrLn (formatDoc (identDocDocs idoc)))
case identDocArgDocs idoc of
Nothing -> return ()
Just args -> liftIO (putStr (unlines (map (\(i,x) -> formatArg i x) args)))
formatDoc :: Doc String -> String
formatDoc = trim . doc where
data Sexp
= Atom String
| String String
| List [Sexp]
renderSexp :: Sexp -> String
renderSexp (Atom string) = string
renderSexp (String string) = show string
renderSexp (List sexps) = "(" ++ intercalate " " (map renderSexp sexps) ++ ")"
toSexp :: IdentDoc -> Ghc Sexp
toSexp idoc =
do d <- getSessionDynFlags
return (List (concat (object d)))
where
object d =
[[List [Atom "package",String (showPackageName (identDocPackageName idoc))]]
,[List [Atom "module",String (showppr d (moduleName (nameModule (getName i))))]
|Just i <- [identDocIdent idoc]]
,[List [Atom "type",String (showppr d (idType i))]
|Just i <- [identDocIdent idoc]]
,[List [Atom "arguments",List ((map (\(i,x) -> String (formatArg i x)) args))]
|Just args <- [identDocArgDocs idoc]]
,[List [Atom "documentation",String (formatDoc (identDocDocs idoc))]]]
formatArg :: Show a => a -> Doc String -> String
formatArg i x = prefix ++
indentAfter (length prefix) (formatDoc x)
where prefix = show i ++ ": "
indentAfter :: Int -> String -> String
indentAfter i xs = intercalate "\n" (take 1 l ++ map (replicate (i1) ' ' ++) (drop 1 l))
where l = lines xs