module Monocle.Tex where

import Monocle.Core
import Monocle.Utils
import Monocle.Markup

import IO
import Control.Monad.State
import qualified Data.Map as Map

class Texified a where
    tex :: a -> String
    doc :: a -> String

-- TeX utilities

s'join inf [] = ""
s'join inf (x:xs) = foldl (\x y -> x++inf++y) x xs

t'sub x = "_{" ++ x ++ "}"
t'sup x = "^{" ++ x ++ "}"

t'id x = " id" ++ (t'sub x)

t'op op [] = ""
t'op op (z:[]) = z
t'op op (z:zs) = (foldl (\x y -> x++op++" "++y) z zs)

t'rop op [] = ""
t'rop op x = t'op op $ reverse x

t'open x =
    if not $ null x then
        if head x == '(' && last x == ')'
            then init $ tail x
            else x
    else x
t'close x =
    if not $ null x then
        if head x /= '(' || last x /= ')'
            then "(" ++ x ++ ")"
            else x
    else x

t'cmd cmd x = " \\" ++ cmd ++ "{" ++ x ++ "}"
t'sf x = t'cmd "textsf" x

t'begin x = t'cmd "begin" x
t'end x = t'cmd "end" x

t'endl = "\n"
t'math f = "$" ++ f ++ "$"


-- TeX primitives

t'docMap mp = map doc $ filter (not.isId) $ fst $ unzip $ Map.toList mp
t'docType_ fobj f = (t'open $ fobj $ dom f)++"\\to "++(t'open $ fobj $ cod f)
t'docHead_ ftex fobj wd f = t'endl ++ (t'sf wd) ++ ( t'math $ (t'open $ ftex f) ++ ": " ++ (t'docType_ fobj f) ) ++ t'endl

t'itemize [] = ""
t'itemize items = t'endl ++ (t'begin "itemize") ++
    (foldl (\x y -> x++"\n\\item "++y) "" items) ++ (t'end "itemize") ++ t'endl


t'doc_ ftex fobj wd f mp = (t'docHead_ ftex fobj wd f) ++ (t'sf " where ") ++ (t'itemize $ t'docMap mp)
t'texF_ ftex nm xs = nm ++ (t'close $ s'join ", " $ map ftex xs)

t'texNaturalTfm_ ftex fobj x xs = (ftex x) ++ (t'sub $ t'op ", " $ map fobj xs)

-- TeXify Mor

t'texMor f = case f of
    Arrow y _ -> str y
    Func nm xs t -> case t of
        Function -> t'texF_ t'texMor nm xs
        Functor -> t'texF_ t'texMor nm xs
        Cofunctor -> t'texF_ t'texMor nm xs
    Transform nm x xs ->  t'texNaturalTfm_ t'texMor t'objMor x xs
    Id y -> t'id $ str y
    Tensor [] -> "I"
    Tensor y -> t'close $ t'op "\\otimes" $ map t'texMor y
    Composition y -> t'close $ t'rop "\\circ" $ map t'texMor y

t'objMor f = case f of
    Func nm xs t -> case t of
        Function -> t'texF_ t'objMor nm xs
        Functor -> t'texF_ t'objMor nm xs
        Cofunctor -> t'texF_ t'objMor nm xs
    Id y -> str y
    Tensor y -> t'close $ t'op "\\otimes" $ map t'objMor y
    _ -> error "texObj: not an object"


instance (Printable a, Ord a) => Texified (Mor a) where
    tex f = t'math $ t'open $ t'texMor f

    doc f = if terminal f then
        if not $ isId f then t'docHead_ t'texMor t'objMor "morphism " f else ""
        else t'doc_ t'texMor t'objMor "morphism " f $ collect f

texObj f = t'open (t'objMor f)

-- TeXify Rule

instance (Printable a, Ord a) => Texified (Rule a) where
    tex (DefEqual l r) = (t'sf "rule ")++ ( t'math ( (t'texMor l) ++ "\\equiv " ++ (t'texMor r) ) )
    doc s@(DefEqual l r) = (tex s) ++ (t'sf " where ") ++ t'endl ++ (t'begin "itemize") ++ "\\item "++
        (doc l) ++ "\\item " ++ (doc r) ++ (t'end "itemize")

-- TeXify Lab

t'mblab lab x =
    if null lab then x
    else (t'close x) ++ (t'sub lab)

t'texLab f = case f of
    MFunc nm xs t lab -> t'mblab lab $ case t of
        Function -> t'texF_ t'texLab nm xs
        Functor -> t'texF_ t'texLab nm xs
        Cofunctor -> t'texF_ t'texLab nm xs
    MTransform nm x xs lab ->  t'mblab lab $ t'texNaturalTfm_ t'texLab t'objMor x xs
    MTensor [] lab -> t'mblab lab "I"
    MTensor xs lab -> t'mblab lab $  t'op "\\otimes" $ map t'texLab xs
    MComposition xs lab -> t'mblab lab $  t'op "\\circ" $ map t'texLab xs
    _ ->  t'mblab (getLabel f) $ t'texMor $ unmark f

t'objLab f = case f of
    MFunc nm xs t lab -> t'mblab lab $ case t of
        Function -> t'texF_ t'objLab nm xs
        Functor -> t'texF_ t'objLab nm xs
        Cofunctor -> t'texF_ t'objLab nm xs
    MId f lab -> t'mblab lab $ texObj f
    MTensor xs lab -> t'mblab lab $ t'op "\\otimes" $ map t'objLab xs
    _ -> error "texObjLab: not an object"

texObjLab f = t'open (t'objLab f)

instance (Printable a, Ord a) => Texified (Lab a) where
    tex f = t'math $ t'open $ t'texLab f

    doc f = if terminal $ unmark f then
        if not $ isId f then t'docHead_ t'texLab t'objLab "marked morphism " f else ""
        else t'doc_ t'texLab t'objLab "marked morphism " f $ collect $ unmark f

-- IO

ptex f = do putStrLn $ tex f
pobj f = do putStrLn $ texObj f
pdoc f = do putStrLn $ doc f