{-# LANGUAGE OverloadedStrings #-}
module MarXup.Latex where

import Control.Applicative
import MarXup.Tex
import MarXup.MetaPost
import Data.List (intersperse)
import Data.Monoid

-- Separate the arguments with '\\'
mkrows :: [TeX] -> TeX
mkrows ls = sequence_ $ intersperse newline ls 

-- Separate the arguments with '&'
mkcols = sequence_ . intersperse newcol

vspace = cmd "vspace"
title = cmd "title"

newline = backslash <> backslash
newcol = tex "&"
newpara = texLines ["",""]

maketitle :: Tex ()
maketitle = cmd "maketitle" $ return ()

ldots = cmd "ldots" (return ())

section s = 
  do cmd "section" s
     label

subsection s = 
  do cmd "subsection" s
     label

color :: String -> Tex a -> Tex a
color col bod = do 
  [_,x] <- cmdn' "textcolor" [] [tex col >> return undefined, bod]
  return x

----------------
-- Preamble stuff

usepackage opts name = cmd' "usepackage" opts (Tex name)

stdPreamble = do 
  usepackage [] "graphicx"
  usepackage ["mathletters"] "ucs"
  usepackage ["utf8x"] "inputenc"
  return ()

latexDocument :: String -> [String] -> Tex a -> Tex a -> Tex ()
latexDocument docClass options pre body = do
   preamble
   Metapost $ metaPostPreamble preamble
   env "document" body
   Metapost $ metaPostEpilogue
 where 
   preamble = do
     cmd' "documentclass" options (Tex docClass)
     pre
         

----------
-- Fonts

sf, em :: Tex a -> Tex a
sf = cmd "textsf"
em = cmd "emph"

----------
-- Math

align  = env "align*" . mkrows . map mkcols 

block  bod = do
  cmdn' "begin" [] [tex "array", tex "l"]
  mkrows $ bod
  cmdn' "end" [] [tex "array"]

math = cmd "ensuremath"
mbox = cmd "mbox"

displayMath body = Tex "\\[" *> body <* Tex "\\]"

paren bod = do
  tex "("
  bod
  tex ")"

brack bod = do
  tex "["
  bod
  tex "]"

brac bod = do
  backslash >> tex "{"
  bod
  backslash >> tex "}"


mathsf = cmd "mathsf"

instance Eq TeX where
instance Show TeX where
  

instance Fractional TeX where
    a / b = cmdn_ "frac" [a,b]

instance Floating TeX where
    pi = cmd "pi" nil
    exp x = "e^" <> braces x
    sqrt = cmd "sqrt"

instance Num TeX where
  fromInteger x = text $ show x
  (+) = binop $ text "+"
  (-) = binop $ text "-"
  (*) = binop $ text "*"
  negate x = "-" <> x

binop :: TeX -> TeX -> TeX -> TeX
binop op a b = a <> op <> b