Copyright © 2008 Dave Bayer. Subject to a BSD-style license.
This module is part of the Annote project.
module Convert (style,annote) where
Convert provides code specific to turning Haskell source files into
HTML documentation.
System.Exit handles exiting the program.
We import the following value:
exitFailure :: IO a
import System.Exit (exitFailure)
System.IO is the standard IO library.
We import the following functions:
hGetContents :: Handle -> IO String
hPutStr :: Handle -> String -> IO ()
hPutStrLn :: Handle -> String -> IO ()
import System.IO (stderr,hPutStr,hPutStrLn)
Files provides miscellaneous file utilities.
import Files (createDirectory,doesFileExist,doesDirectoryExist,baseName,
newSuffix,isNewer)
Run provides the function runCommand, which
forks threads to call runInteractiveCommand, waiting
for the result and handling errors.
import Run (runCommand)
Strings provides the strings header, date, footer, and
sheet, defined as here documents.
import Strings (header,date,footer,sheet)
Regex provides regular expression matching.
It is a wrapper around Text.Regex.
import Regex (mkRegex,mkSub,doSub,isMatch)
GetOpt handles command line options.
It is a wrapper around System.Console.GetOpt.
import GetOpt (isOption,getOption,getOptionOr)
Options declares the command line options.
import Options (Flag(..),Options)
Split
divides an input file into code, documentation, and external documentation.
import Split (Delims,split,joinDoc,joinCode)
Filter processes the Code and Doc lines of split input text.
import Filter (doGeneric)
Haskell provides a language-specific filter
for the language
Haskell.
import Haskell (doHaskell)
pagepage wraps the string s in an HTML header and footer.
It substitutes the file name f for the header text {TITLE},
and today's date for the footer text {DATE}.
page :: String → String → String → String
page day file body =
if day == ""
then top ++ body ++ footer
else top ++ body ++ stamp ++ footer
where title = doSub file $ mkSub (".hs$|.txt$", "")
top = doSub header $ mkSub ("[{]TITLE[}]", title)
stamp = doSub date $ mkSub ("[{]DATE[}]", day)
stylestyle writes the style sheet,
if if doesn't exist or if the ForceStyle option is selected.
style :: Options → IO ()
style options = do
let dir = getOption DocDir options
css = dir ++ '/' : "annote.css"
ok1 ← doesDirectoryExist dir
if ok1 then return () else createDirectory dir
ok2 ← doesFileExist css
if not ok2 || isOption ForceStyle options
then writeFile css sheet
else return ()
getDelimsgetDelims sets the document start and end delimiters.
getDelims :: Options → Delims → Delims
getDelims options (start,end,xstart,xend) =
let pad s = if null s then s else "^" ++ s ++ "[ \t]*$"
in (pad $ getOptionOr DocStart options start,
pad $ getOptionOr DocEnd options end,
pad $ getOptionOr ExtStart options xstart,
pad $ getOptionOr ExtEnd options xend)
dispatchdispatch determines source code processing,
based on the file extension.
dispatch :: Options → String → String → (IO String, String)
dispatch options file text = f xs where
xs = [ ("[.]hs$", doHaskell, ("[{]-", "-[}]", "[{]-[|]", "-[}]"))
, ("[.](c|cp)$", doGeneric, ("/[*]", "[*]/", [], []))
, ("[.]py$", doGeneric, ("[ \t]*\"\"\"", "[ \t]*\"\"\"", [], []))
, ("[.]pl$", doGeneric, ("=pod", "=cut", [], []))
, ("[.]m2$", doGeneric, ("///[*]", "[*]///;", [], []))
, (".*", doGeneric, ("[{]-", "-[}]", [], []))
]
isCode = not $ isMatch file $ mkRegex "[.]txt"
f [] = undefined
f ((pat,doSrc,delims):xt) =
if isMatch file $ mkRegex pat
then let raw = split isCode (getDelims options delims) text
in ((joinDoc . doSrc) raw, joinCode raw)
else f xt
timestamptimestamp returns the current date and time.
timestamp returns the monadic type IO String because
its value depends on the outside environment.
timestamp :: String → IO String
timestamp format = do
(time,ok) ← runCommand ("date +'" ++ format ++ "'") [] False
return $ if ok then time else "???"
checkFiltercheckFilter checks to see if the markup filter exists, exiting if it
cannot be found.
checkFilter :: FilePath → IO ()
checkFilter mark = do
(_,ok) ← runCommand ("which " ++ mark) [] False
if ok then return () else do
hPutStrLn stderr $ mark ++ " not found"
exitFailure
annoteannote is the primary exported function of this module, writing a
complete HTML documentation page generated from the input source file.
annote :: Options → FilePath → IO ()
annote options file = do
let dir = (getOption DocDir options) ++ "/"
base = baseName file
html = dir ++ newSuffix base "html"
code = dir ++ base
newer ← isNewer file html
if not newer then return () else do
day ← timestamp $ getOption DateFormat options
let write doc src = do
writeFile html $ page day file doc
if isOption Code options
then writeFile code src
else return ()
text ← readFile file
let (iodoc,src) = dispatch options file text
doc ← iodoc
if isOption NoFilter options
then write doc src
else do
let mark = getOption Filter options
checkFilter mark
(out,ok) ← runCommand mark doc False
if ok then write out src
else hPutStr stderr out