-- | This module defines some macros to speed up writing documents.
--
-- Note: Have you an idea for a macro? Send your suggestions!
module Text.LaTeX.Macro (
       -- * Simple macros
       m_simple
     , m_wpkgs
       -- * Article macros
     , m_article
     , m_articlep
       -- * Math macros
     , m_math
       ) where

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

-- Simple macros

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

m_wpkgs
  :: Monad m =>
     [ClassOption m]        -- ^ Class options
     -> Class m             -- ^ Class
     -> Name m              -- ^ Author's name
     -> Title m             -- ^ Document's title
     -> [([PackageOption m] 
        ,  Package m)]      -- ^ A list of imported packages
     -> LaTeX m             -- ^ Document's content
     -> LaTeX m             -- ^ 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
  :: Monad m =>
     Name m      -- ^ Author's name
     -> Title m  -- ^ Article's title
     -> LaTeX m  -- ^ Article's content
     -> LaTeX m  -- ^ Output
m_article a t cnt =
   do documentclass [pt 11, titlepage, a4paper] article
      author a
      title t
      document $ do maketitle
                    cnt

-- | Like 'm_article', but it lets you import packages.
m_articlep
  :: Monad m =>
     Name m                              -- ^ Author's name
     -> Title m                          -- ^ Article's title
     -> [([PackageOption m], Package m)] -- ^ A list of imported packages
     -> LaTeX m                          -- ^ Document's content
     -> LaTeX m                          -- ^ Output
m_articlep a t pkgs cnt =
   do documentclass [pt 11, titlepage, a4paper] article
      mapM_ (uncurry usepackage) pkgs
      author a ; title t
      document $ do maketitle
                    cnt

-- Math macros

-- | Macro for math articles. Like 'm_article', but importing 'amsmath' package.
m_math
  :: Monad m =>
     Name m        -- ^ Author's name
     -> Title m    -- ^ Article's title
     -> LaTeX m    -- ^ Document's content
        -> LaTeX m -- ^ Output
m_math a t cnt = m_articlep a t [([],amsmath)] cnt