-- | This package extends Cabal's documentation building capabilities.
-- It extends the Haddock markup language with syntax for subscripts,
-- superscripts, bold text, non-breaking spaces, and images. Moreover,
-- it works around various bugs in Haddock's and HsColour's Unicode
-- support, making it possible to use UTF8 encodings in both source
-- code and documentation comments.
-- 
-- This package is designed to work transparently. It provides a
-- custom main function that package maintainers can use in their
-- @Setup.hs@ file.

module Distribution.Superdoc (
  -- $HOWTO_ANCHOR
  
  -- * How to use this package
  -- $HOWTOUSE
  
  -- $MARKUP_ANCHOR
  
  -- * Markup
  -- $MARKUP
  
  -- * Unicode
  -- $UNICODE
  
  -- $IMAGES_ANCHOR
  
  -- * Using images
  -- $IMAGES
  
  -- ** Setting the image directory
  -- $IMAGES_CUSTOM
  
  -- ** Images via extra-html-files
  -- $IMAGES_CHECK
  
  -- $HOWITWORKS_ANCHOR
  
  -- * How it works  
  -- $HOWITWORKS
  
  -- * API functions
  -- $API
  
  -- ** Default entry point
  superdocMain,
  
  -- ** Parameters
  SuperdocArgs (..),
  defaultSuperdocArgs,
  ImageSource (..),
  ImageMissing (..),
  
  -- ** Alternate entry point
  superdocMainArgs,
  
  -- ** User hooks
  superdocHooks,
  superdocHooksArgs,
  ) where

import Distribution.Superdoc.Hooks
import Distribution.Simple

-- $HOWTO_ANCHOR #HOWTO#

-- ----------------------------------------------------------------------
-- * How to use this package

-- $HOWTOUSE
-- 
-- Using the extended markup and Unicode in your own packages is very
-- easy. In most cases, only three or four simple steps are required:
-- 
-- 1. Set the package propery \"@build-type@\" to \"@Custom@\" in your
-- @.cabal@ file;
-- 
-- 2. Add \"@superdoc@\" to the \"@build-depends@\" field in your
-- @.cabal@ file;
-- 
-- 3. (Optional): Add any image files to the \"@images@\" directory in
-- your package root, and add the filenames to the
-- \"@extra-source-files@\" package propery in your @.cabal@ file;
-- 
-- 4. Create a file @Setup.hs@ containing the following two lines:
-- 
-- > import Distribution.Superdoc
-- > main = superdocMain
-- 
-- Then just mark up your sources and run \"@cabal haddock@\" as usual. 

-- $MARKUP_ANCHOR #MARKUP#

-- ----------------------------------------------------------------------
-- * Markup

-- $MARKUP
-- 
-- Superdoc recognizes the following markup, in addition to the
-- usual Haddock markup:
-- 
-- * [bold [literal [super /text/]]]: superscript.
-- 
-- * [bold [literal [sup /text/]]]: superscript.  A synonym for 
--   [literal [super /text/]].
-- 
-- * [bold [literal [sub /text/]]]: subscript.
-- 
-- * [bold [literal [exp /text/]]]: exponential function.
-- 
-- * [bold [literal [bold /text/]]]: bold.
-- 
-- * [bold [literal [center /text/]]]: centered.
-- 
-- * [bold [literal [nobr /text/]]]: inhibit line breaks.
-- 
-- * [bold [literal [image /filename/]]]: insert image.
--   See <#IMAGES Using images> for more information.
-- 
-- * [bold [literal [uni /nnnn/]]]: Unicode character.
-- 
-- * [bold [literal [literal text]]]: literal text. Brackets \'[\' and
-- \']\' may only occur in nested pairs.
-- 
-- All tags except image, uni, and literal can be nested.
-- Here are some examples:
-- 
-- @
-- [bold Markup:]                         [bold Output:]
-- 2[[literal super] \/n\/]                    2[super /n/]
-- 2[[literal sup] \/n\/]                      2[sup /n/]
-- \/x\/[[literal sub] 2]                      /x/[sub 2]
-- [[literal exp] \/i\/πθ]                     [exp /i/πθ]
-- [[literal bold] this]                     [bold this]
-- [[literal center] this]                   [center this]
-- [[literal nobr] Henry VIII]               [nobr Henry VIII]
-- [[literal image] myimage.png]             [image myimage.png]
-- [[literal uni] 9786]                      [uni 9786]
-- [literal [literal [bold text]]]           [literal [bold text]]
-- [literal 2[sup [bold n][sub \/i\/]]]        2[sup [bold n][sub /i/]]
-- @
-- 
-- There are some cases where Haddock assigns special meaning to the
-- bracket \'[\', notably at the beginning of a paragraph. In such
-- cases, you must escape the \'[\' with a backslash to use it as a
-- Superdoc tag. For example, to display an image on a line by itself,
-- use
-- 
-- > \[literal [image myimage.png]]

-- ----------------------------------------------------------------------
-- * Unicode

-- $UNICODE
-- 
-- Unicode can be very useful in documentation, especially for
-- mathematical applications. With Superdoc, you can use Unicode
-- directly in your documentation markup, using the UTF8 encoding. You
-- can also use Unicode in your Haskell sources. Here is an example of
-- documentation markup:
-- 
-- \[bold Theorem.] Let ξ ∈ ℤ[√2], and assume that ξ ≥ 0, ξ[sup •] ≥
-- 0, and that /p/ = ξ[sup •]ξ is a prime [nobr ≡ 1] [nobr (mod 4)] in
-- ℤ. Then there exists some /t/ ∈ ℤ[ω] such that /t/[sup †]/t/ = ξ.

-- $IMAGES_ANCHOR #IMAGES#

-- ----------------------------------------------------------------------
-- * Using images

-- $IMAGES
-- 
-- You can embed images in your documentation using the tag [bold
-- [literal [image /filename/]]]. By default, Superdoc looks for image
-- files in the directory \"@images@\" at the root of your package.
-- Superdoc takes care of copying the image files to their correct
-- location within the generated HTML documentation.  It is an error
-- to link to an image that does not actually exist, and in this case
-- \"@cabal haddock@\" will fail with an error message.
-- 
-- If you are using any images, you must also add them to the
-- \"@extra-source-files@\" package property in your @.cabal@ file,
-- for example like this:
-- 
-- > extra-source-files:  images/*.png
-- 
-- This ensures that the images will be included when you build a
-- source distribution from your package with \"@cabal sdist@\".

-- ----------------------------------------------------------------------
-- ** Setting the image directory

-- $IMAGES_CUSTOM
-- 
-- By default, Superdoc looks for images in the \"@images@\" directory of
-- your package. If your images reside in a different location, you
-- can inform Superdoc of this by passing an 'imageSource' parameter,
-- as follows:
-- 
-- > import Distribution.Superdoc
-- > main = superdocMainArgs defaultSuperdocArgs { imageSource = CopyFrom "imgdir" }

-- ----------------------------------------------------------------------
-- ** Images via extra-html-files

-- $IMAGES_CHECK
-- 
-- Some newer versions of Cabal also support an \"@extra-html-files@\"
-- package property. If you add your images to this, instead of
-- \"@extra-source-files@\", then Cabal (and not Superdoc) will copy
-- the images to their rightful location in the HTML documentation. In
-- this case, you should tell Superdoc not to copy the images
-- again. This can be done by setting 'imageSource' to 'ExtraHtmlFiles':
-- 
-- > import Distribution.Superdoc
-- > main = superdocMainArgs defaultSuperdocArgs { imageSource = ExtraHtmlFiles }
-- 
-- In this case, Superdoc will not copy the images, but it will still
-- check that Cabal has done so. It is still an error to link to a
-- non-existing image.
 
-- $HOWITWORKS_ANCHOR #HOWITWORKS#

-- ----------------------------------------------------------------------
-- * How it works

-- $HOWITWORKS 
-- 
-- Internally, this package is implemented as a bunch of Cabal hooks
-- for pre- and post-processing the input and output of Haddock and
-- HsColour.  In this way, we do not actually have to modify Haddock
-- and HsColour themselves. Here is a brief explanation of how it works:
-- 
-- 1. We pre-process the input of Haddock by converting each Unicode
-- character to an ASCII sequence, such as \"[bold [literal uni_x_9786_x_]]\".
-- This process is called /armoring/. The armoring is done in a way
-- that preserves the validity of Haskell identifiers and operators,
-- i.e., the armored version of a valid upper- or lower-case
-- identifier or operator is again a valid identifier or operator of
-- the same kind. As a result, it is possible to use Unicode not only
-- in documentation comments, but also in the source code
-- itself. (Haskell already handles Unicode correctly anyway, but most
-- Haddock versions don't).
-- 
-- 2. We post-process the output of Haddock to convert the armored
-- Unicode characters into proper HTML escape sequences, such as \"\&#9786;\".
-- 
-- 3. At the same time, we also post-process the output of Haddock to
-- interpret Superdoc markup tags, as described in <#MARKUP Markup>.
-- 
-- 4. Finally, we also post-process the output of HsColour. The
-- HsColour program natively just copies any Unicode characters to the
-- output unchanged; however, the resulting pages may not display
-- correctly in web browsers that are set to use a different character
-- encoding. We therefore convert any such characters to
-- encoding-independent HTML sequences such as \"\&#9786;\".

-- ----------------------------------------------------------------------
-- * API functions

-- $API
-- 
-- This module exports main functions that can be used in @Setup.hs@
-- scripts. The standard entry point is 'superdocMain'.
-- Alternatively, the entry point 'superdocMainArgs'
-- can be used if additional package parameters need to be specified.
-- We also provide predefined set of 'UserHooks' that can be used with
-- 'defaultMainWithHooks'.

-- ----------------------------------------------------------------------
-- ** Default entry point

-- | The main function for a Cabal setup script. Use this instead of
-- 'defaultMain' in your @Setup.hs@ to enable the Superdoc
-- documentation features. Typical usage:
-- 
-- > import Distribution.Superdoc
-- > main = superdocMain
-- 
-- See <#HOWTO How to use this package> for more information.
superdocMain :: IO ()
superdocMain = defaultMainWithHooks superdocHooks 
  
-- ----------------------------------------------------------------------
-- ** Parameters

-- See Distribution.Superdoc.Hooks.

-- ----------------------------------------------------------------------
-- ** Alternate entry point

-- | Like 'superdocMain', but also accept parameters
-- in the form of a 'SuperdocArgs' argument. Typical use:
-- 
-- > import Distribution.Superdoc
-- > main = superdocMainWithArgs defaultSuperdocArgs { imageSource = CopyFrom "imgdir" }
superdocMainArgs :: SuperdocArgs -> IO ()
superdocMainArgs sdargs = defaultMainWithHooks (superdocHooksArgs sdargs)
  
-- ----------------------------------------------------------------------
-- ** User hooks

-- | A predefined set of 'UserHooks' for package maintainers who need
-- to use the 'defaultMainWithHooks' function from
-- "Distribution.Simple". The following is equivalent to
-- 'superdocMain':
-- 
-- > import Distribution.Simple
-- > import Distribution.Superdoc
-- > main = defaultMainWithHooks superdocHooks
superdocHooks :: UserHooks  
superdocHooks = superdocHooksArgs defaultSuperdocArgs

-- | Like 'superdocHooks', but also accept parameters in
-- the form of a 'SuperdocArgs' argument. Typical use:
-- 
-- > import Distribution.Simple
-- > import Distribution.Superdoc
-- > main = defaultMainWithHooks superdocHooksArgs { imageSource = CopyFrom "imgdir" }
superdocHooksArgs :: SuperdocArgs -> UserHooks  
superdocHooksArgs sdargs = simpleUserHooks { 
  postHaddock = posthaddock sdargs, 
  postHscolour = posthscolour sdargs, 
  haddockHook = haddockhook sdargs
}