%-------------------------------=  --------------------------------------------
\subsection{Math formatter}
%-------------------------------=  --------------------------------------------

%if codeOnly || showModuleHeader

> module Math                   (  module Math, substitute, number  )
> where
>
> import Prelude hiding         (  lines )
> import Data.List              (  partition )
> import Numeric                (  showFFloat )
> import Control.Applicative
> import Control.Arrow          (  (>>>) )
> import Control.Monad          (  (>=>) )
>
> import Verbatim               (  expand, trim )
> import MathCommon
> import Document
> import Directives
> import HsLexer
> import Parser
> import Auxiliaries
> import TeXCommands ( Lang(..) )

%endif

% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Inline and display code}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -

> inline                        :: Lang -> Formats -> Bool -> String -> Either Exc Doc
> inline lang fmts auto         =   fmap unNL
>                               >>> tokenize lang
>                               >=> lift (number 1 1)
>                               >=> when auto (lift (filter (isNotSpace . token)))
>                               >=> lift (partition (\t -> catCode t /= White))
>                               >=> exprParse *** return
>                               >=> lift (substitute fmts auto) *** return
>                               >=> lift (uncurry merge)
>                               >=> lift (fmap token)
>                               >=> when auto (lift addSpaces)
>                               >=> lift (latexs fmts)
>                               >=> lift sub'inline

> display                       :: Lang -> Formats -> Bool -> (Stack, Stack) -> Maybe Int
>                               -> String -> Either Exc (Doc, (Stack,Stack))
> display lang fmts auto sts col=   lift trim
>                               >=> lift (expand 0)
>                               >=> tokenize lang
>                               >=> lift (number 1 1)
>                               >=> when auto (lift (filter (isNotSpace . token)))
>                               >=> lift (partition (\t -> catCode t /= White))
>                               >=> exprParse *** return
>                               >=> lift (substitute fmts auto) *** return
>                               >=> lift (uncurry merge)
>                               >=> lift lines
>                               >=> lift (align col)
>                               >=> when auto (lift (fmap (fmap addSpaces)))
>                               >=> lift (leftIndent fmts auto sts)
>                               >=> lift sub'code *** return

% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{A very simple Haskell Parser}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -

The parser is based on the Smugweb parser.
This variant cannot handle unbalanced parentheses.

> exprParse                     :: (CToken tok, Show tok) => [Pos tok] -> Either Exc [Item (Pos tok)]
> exprParse s                   =  case run chunk s of
>     Nothing                   -> Left ("syntax error", show s) -- HACK: |show s|
>     Just e                    -> Right e
>
> chunk                         :: (CToken tok) => Parser (Pos tok) (Chunk (Pos tok))
> chunk                         =  do a <- many atom
>                                     as <- many (do s <- sep; a' <- many atom; return (Delim s : offside a'))
>                                     return (offside a ++ concat as)
>     where offside []          =  []
>           -- old: |opt a =  [Apply a]|
>           offside (a : as)    =  Apply (a : bs) : offside cs
>               where (bs, cs)  =  span (\a' -> col' a < col' a') as
>           col' (Atom a)       =  poscol a
>           col' (Paren a _ _)  =  poscol a
>
> atom                          :: (CToken tok) => Parser (Pos tok) (Atom (Pos tok))
> atom                          =   fmap Atom noSep
>                               <|> do l <- left
>                                      e <- chunk
>                                      r <- right l
>                                      return (Paren l e r)

Primitive parser.

> sep, noSep, left              :: (CToken tok) => Parser tok tok
> sep                           =  satisfy (\t -> catCode t == Sep)
> noSep                         =  satisfy (\t -> catCode t == NoSep)
> left                          =  satisfy (\t -> case catCode t of Del c -> c `elem` "(["; _-> False)
>
> right                         :: (CToken tok) => tok -> Parser tok tok
> right l                       =  satisfy (\c' -> case (catCode l, catCode c') of
>                                      (Del o, Del c) -> (o,c) `elem` zip "([" ")]"
>                                      _     -> False)

% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Internal alignment}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -

\Todo{Internal alignment Spalte automatisch bestimmen. Vorsicht: die
Position von |=| oder |::| heranzuziehen ist gef"ahrlich; wenn z.B.
|let x = e| in einem |do|-Ausdruck vorkommt.}

> data Line a                   =  Blank
>                               |  Three a a a
>                               |  Multi a
>
> align                         :: (CToken tok) => Maybe Int -> [[Pos tok]] -> [Line [Pos tok]]
> align c                       =  fmap (maybe Multi split3 c)
>   where
>   split3 i ts                 =  case span (\t -> poscol t < i) ts of
>       ([], [])                -> Blank
>       ((_ : _), [])           -> Multi ts
>       (us, v : vs)
>           | poscol v == i && isInternal v
>                               -> Three us [v] vs
>           | null us           -> Three [] [] (v : vs)
>           | otherwise         -> Multi ts
>
>
> isInternal                    :: (CToken tok) => tok -> Bool
> isInternal t                  =  case token t of
>     Consym _                  -> True
>     Varsym _                  -> True
>     Special _                 -> True
>     _                         -> False
>
> instance Functor Line where
>     fmap _f Blank             =  Blank
>     fmap  f (Three l c r)     =  Three (f l) (f c) (f r)
>     fmap  f (Multi a)         =  Multi (f a)

% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Adding spaces}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -

Inserting spaces before and after keywords. We use a simple finite
automata with three states: |before b| means before a keyword, |b|
indicates whether to insert a space or not; |after| means immediately
after a keyword (hence |before b| really means not immediately after).

> addSpaces                     :: (CToken tok) => [tok] -> [tok]
> addSpaces ts0                 =  before False ts0
>     where
>     before _b []              =  []
>     before  b (t : ts)        =  case token t of
>         u | selfSpacing u     -> t : before False ts
>         Special c
>           | c `elem` ",;([{"  -> t : before False ts
>         Keyword _             -> [ fromToken (TeX False sub'space) | b ] ++ t : after ts
>         _                     -> t : before True ts
>
>     after []                  =  []
>     after (t : ts)            =  case token t of
>         u | selfSpacing u     -> t : before False ts
>         Special c
>           | c `elem` ",;([{"  -> fromToken (TeX False sub'space) : t : before False ts
>         Keyword _             -> fromToken (TeX False sub'space) : t : after ts
>         _                     -> fromToken (TeX False sub'space) : t : before True ts

Operators are `self spacing'.

> selfSpacing                   :: Token -> Bool
> selfSpacing (Consym _)        =  True
> selfSpacing (Varsym _)        =  True
> selfSpacing (Op _)            =  True
> -- |selfSpacing (TeX _) =  True|
> selfSpacing _                 =  False

\NB It's not a good idea to regard inline \TeX\ as self spacing consider,
for example, a macro like @%format mu = "\mu "@.

% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
\subsubsection{Left indentation}
% - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -

Auch wenn |auto = False| wird der Stack auf dem laufenden gehalten.

> type Stack                    =  [(Col, Doc, [Pos Token])]
>
> leftIndent ::
>   Formats
>   -> Bool
>   -> (Stack, Stack)
>   -> [Line [Pos Token]]
>   -> (Doc, (Stack, Stack))
> leftIndent dict auto (lst0, rst0)
>                               =  loop lst0 rst0
>   where
>   copy d | auto               =  d
>          | otherwise          =  Empty

Die Funktion |isInternal| pr"uft, ob |v| ein spezielles Symbol wie
@::@, @=@ etc~oder ein Operator wie @++@ ist.

>   loop lst rst []             =  (Empty, (lst, rst))
>   loop lst rst (l' : ls)      =  case l' of
>       Blank                   -> loop lst rst ls
>       Three l c r             -> (sub'column3 (copy lskip <<>> latexs dict l)
>                                               (latexs dict c)
>                                               (copy rskip <<>> latexs dict r) <<>> sep' ls <<>> rest, st')
>           where (lskip, lst') =  indent l lst
>                 (rskip, rst') =  indent r rst
>                 (rest, st')   =  loop lst' rst' ls -- does not work: |if null l && null c then rst' else []|
>       Multi m                 -> (sub'column1 (copy lskip <<>> latexs dict m) <<>> sep' ls <<>> rest, st')
>           where (lskip, lst') =  indent m lst
>                 (rest, st')   =  loop lst' [] ls
>
>   sep' []                     =  Empty
>   sep' (Blank : _ )           =  sub'blankline
>   sep' (_ : _)                =  sub'nl
>
>   indent                      :: [Pos Token] -> Stack -> (Doc, Stack)
>   indent [] stack             =  (Empty, stack)
>   indent ts@(t : _) []        =  (Empty, [(poscol t, Empty, ts)])
>   indent ts@(t : _) (top@(c, skip, line) : stack)
>                               =  case compare (poscol t) c of
>       LT                      -> indent ts stack
>       EQ                      -> (skip, (c, skip, ts) : stack)
>       GT                      -> (skip', (poscol t, skip', ts) : top : stack)
>           where
>           skip'               =  case span (\u -> poscol u < poscol t) line of
>               (us, v : _vs) | poscol v == poscol t
>                               -> skip <<>> sub'phantom (latexs dict us)
>               -- does not work: |(us, _) -> skip ++ [Phantom (fmap token us), Skip (col t - last (c : fmap col us))]|
>               _               -> skip <<>> sub'hskip (Text em)
>                   where em    =  showFFloat (Just 2) (0.5 * fromIntegral (poscol t - c) :: Double) ""

M"ussen |v| und |t| zueinander passen?
%
\begin{verbatim}
where |a      =    where |Str c =    [    [    (    {
      |(b, c) =          |c@(..)=    ,    |    ,    ;
                                     ]    ]    )    }
\end{verbatim}

