{-# LANGUAGE OverloadedStrings #-}

-- | This module allows you to add commands and environments of LaTeX wich are not defined in HaTeX.
-- Usually, you don't need to use this functions.
--
-- If a desired command doesn't appear in HaTeX and you need it, use these functions and report the missing function to the maintainer.
module Text.LaTeX.Define (
    -- * Defining Commands
    comm0_
  , comm0
  , comm1
  , comm2
  , comm3
  , comm4
  , comm5
  , comm6
  , comm7
  , comm8
  , comm9
  , comm10
  , comm11
  , comm12
    -- * Defining Environments
  , env
  , env2
  , env3
  ) where

import Control.Monad.Writer
import Data.List (intersperse)

import Data.String.Combinators (braces,comma,brackets)

import Text.LaTeX.Monad
import Text.LaTeX.Result

listOpts :: Monad m => [LaTeX m] -> LaTeX m
listOpts [] = ""
listOpts xs = brackets . sequence_ . intersperse comma $ xs

--

comm0_ :: Monad m => LaTeX m -> LaTeX m
comm0_ = mappend "\\"

comm0 :: Monad m => LaTeX m -> LaTeX m
comm0 n = do comm0_ n
             braces ""


comm1 :: Monad m => LaTeX m -> LaTeX m -> LaTeX m
comm1 n x = do comm0_ n
               braces x

comm2 :: Monad m => LaTeX m -> LaTeX m -> [LaTeX m] -> LaTeX m
comm2 n x opts = do comm1 n x
                    listOpts opts

comm3 :: Monad m => LaTeX m -> [LaTeX m] -> LaTeX m
comm3 n opts = do comm0_ n
                  listOpts opts

comm4 :: Monad m => LaTeX m -> [LaTeX m] -> LaTeX m -> LaTeX m
comm4 n opts x = do comm3 n opts
                    braces x

comm5 :: Monad m => LaTeX m -> LaTeX m -> LaTeX m -> LaTeX m
comm5 n x y = do comm1 n x
                 braces y

comm6 :: Monad m => LaTeX m -> LaTeX m -> [LaTeX m] -> LaTeX m -> LaTeX m
comm6 n x opts y = do comm2 n x opts
                      braces y

comm7 :: Monad m => LaTeX m -> LaTeX m -> [LaTeX m] -> LaTeX m -> LaTeX m -> LaTeX m
comm7 n x opts y z = do comm6 n x opts y
                        braces z

comm8 :: Monad m => LaTeX m -> LaTeX m -> LaTeX m
comm8 n x = braces $ do comm0 n
                        x

comm9 :: Monad m => LaTeX m -> [LaTeX m] -> LaTeX m -> LaTeX m -> LaTeX m
comm9 n opts x y = do comm4 n opts x
                      braces y

comm10 :: Monad m => LaTeX m -> [LaTeX m] -> [LaTeX m] -> LaTeX m -> LaTeX m
comm10 n opts1 opts2 x = do comm3 n opts1
                            listOpts opts2
                            braces x

comm11 :: Monad m => LaTeX m -> LaTeX m -> [LaTeX m] -> [LaTeX m] -> LaTeX m -> LaTeX m
comm11 n x opts1 opts2 y = do comm2 n x opts1
                              listOpts opts2
                              braces y

comm12 :: Monad m => LaTeX m -> LaTeX m -> LaTeX m -> LaTeX m -> LaTeX m
comm12 n x y z = do comm5 n x y
                    braces z

env :: Monad m => LaTeX m -> LaTeX m -> LaTeX m 
env t x = do comm1 "begin" t
             x
             comm1 "end" t

env2 :: Monad m => LaTeX m -> [LaTeX m] -> LaTeX m -> LaTeX m
env2 t opts x = do comm2 "begin" t opts
                   x
                   comm1 "end" t

env3 :: Monad m => LaTeX m -> [LaTeX m] -> LaTeX m -> LaTeX m -> LaTeX m
env3 t opts x y = do comm6 "begin" t opts x
                     y
                     comm1 "end" t