Convert

Convert.hs

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)

page

page 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)

style

style 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 ()

getDelims

getDelims 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) 

dispatch

dispatch 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

timestamp

timestamp 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 "???"

checkFilter

checkFilter 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

annote

annote 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