-- | This module defines some macros to speed up writing documents.
module Text.LaTeX.Macro (
       -- * Simple macros
       m_simple
     , m_wpkgs
       -- * Article macros
     , m_article
       ) where

import Text.LaTeX.Monad
import Text.LaTeX.Commands
import Text.LaTeX.Packages
import Text.LaTeX.Arguments

-- Simple macros

m_simple :: [ClassOption] -- ^ Class options
         ->  Class        -- ^ Class
         ->  Name         -- ^ Author's name
         ->  Title        -- ^ Document's title
         ->  LaTeX        -- ^ Document's content
         ->  LaTeX        -- ^ Output
m_simple copts c a t cnt =
   do documentclass copts c
      author a
      title t
      document cnt

m_wpkgs
  :: [ClassOption]        -- ^ Class options
     -> Class             -- ^ Class
     -> Name              -- ^ Author's name
     -> Title             -- ^ Document's title
     -> [([PackageOption] 
        ,  Package)]      -- ^ A list of imported packages
     -> LaTeX             -- ^ Document's content
     -> LaTeX             -- ^ Output
m_wpkgs copts c a t pkgs cnt =
   do documentclass copts c
      mapM_ (uncurry usepackage) pkgs
      author a
      title t
      document cnt

-- Various macros

-- | Function 'm_article' generate a LaTeX file with the following properties:
--
-- * Article class.
--
-- * Font Size: 11pt
--
-- * A title in the first page.
--
-- * A4 paper.
m_article
  :: Name      -- ^ Author's name
     -> Title  -- ^ Article's title
     -> LaTeX  -- ^ Article's content
     -> LaTeX  -- ^ Output
m_article a t cnt =
   do documentclass [pt 11, titlepage, a4paper] article
      author a
      title t
      document $ do maketitle
                    cnt