content: %-------------------------------=  --------------------------------------------
  \subsection{Main program}
  %-------------------------------=  --------------------------------------------
  
  %if codeOnly || showModuleHeader
  
  > module Main ( main )
  > where
  >
  > import Data.Char ( isSpace )
  > import Data.List ( isPrefixOf )
  > import System.IO
  > import System.Directory ( copyFile )
  > import System.Console.GetOpt
  > import Text.Regex ( matchRegex, mkRegexWithOpts )
  > import System.Environment
  > import System.Exit
  > import System.Process
  > import Control.Arrow
  > import Control.Monad
  > import Control.Monad.Except ( MonadError(..) )
  > import Control.Monad.IO.Class ( liftIO )
  > import Control.Monad.State ( MonadState(..), modify )
  > import Data.Maybe (fromMaybe)
  > import Prelude hiding ( getContents, pi )
  >
  > import qualified Version as V
  > import TeXCommands
  > import TeXParser
  > import qualified Verbatim
  > import qualified Typewriter
  > import qualified Math
  > import qualified MathPoly as Poly
  > import qualified NewCode
  > import Directives
  > import Document
  > import State
  > import StateT
  > import qualified FiniteMap as FM
  > import Auxiliaries
  > import Value hiding ( str )
  > import License
  >
  > import FileNameUtils
  > --import Directory
  
  %endif
  
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  \subsubsection{Main loop}
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  
  > main                          :: IO ()
  > main                          =  getArgs >>= main'
  
  > main'                         :: [String] -> IO ()
  > main' args                    =  case getOpt Permute (options ++ hiddenOptions) args of
  >   (o,n,[])                    -> do hSetEncoding stdin  utf8
  >                                     hSetEncoding stdout utf8
  >                                     hSetEncoding stderr utf8
  >                                     (flags,initdirs,styles)
  >                                        <- foldM (\(s,d,x) (sf,df,ns) -> do s' <- sf s
  >                                                                            return (s',df d,ns ++ x))
  >                                                 (state0,[],[]) o
  >                                     case reverse styles of
  >                                       []  -> lhs2TeX Poly flags (reverse initdirs) n
  >                                           -- ks, 22.11.2005, changed default style to |Poly|
  >                                       [Help]        -> quitSuccess (usageInfo uheader options)
  >                                       [SearchPath]  -> quitSuccess (init . unlines $ V.searchPath)
  >                                       [TeXSearchPath] ->
  >                                         quitSuccess (init . unlines $
  >                                           ["\\begin{code}"] ++ V.searchPath ++ ["\\end{code}"])
  >                                       [Version]     -> quitSuccess programInfo
  >                                       [Copying]     -> quitSuccess (programInfo ++ "\n\n" ++ copying)
  >                                       [Warranty]    -> quitSuccess (programInfo ++ "\n\n" ++ warranty)
  >                                       [Pre] | length n >= 3 -> preprocess flags (reverse initdirs) False n  -- used as preprocessor -pgmF -F
  >                                             | otherwise     -> quitError preTooFewArgsError
  >                                       [Pre,Help] | length n >= 3 -> preprocess flags (reverse initdirs) True n  -- used as literate preprocessor -pgmL
  >                                                  | otherwise     -> quitError preTooFewArgsError
  >                                       [s]    -> lhs2TeX s flags (reverse initdirs) n
  >                                       _      -> quitError (incompatibleStylesError styles)
  >                                     when (output flags /= stdout) (hClose (output flags))
  >   (_,_,errs)                  -> do hPutStrLn stderr $ concat errs
  >                                     hPutStrLn stderr $ "Trying compatibility mode option handling ..."
  >                                     cstyle args
  >  where
  >    quitSuccess s              =  do hPutStrLn stdout $ s
  >                                     exitWith ExitSuccess
  >    quitError s                =  do hPutStrLn stderr $ usageInfo (s ++ "\n" ++ uheader) options
  >                                     exitFailure
  >    incompatibleStylesError ss =  "only one style allowed from: "
  >                                     ++ unwords (map (\s -> "--" ++ decode s) ss) ++ "\n"
  >    preTooFewArgsError         =  "\nlhs2TeX --pre was used with less than 3 args.\n"++
  >                                  "Use this mode as a (literate) preprocessor like `ghci -pgmL lhs2TeX -optL--pre File.lhs`,\n" ++
  >                                  "or test its output with `lhs2TeX --pre -h File.lhs File.lhs output.hs`.\n"
  
  > type Formatter                =  XIO Exc State ()
  
  > initState                     :: Style -> FilePath -> [FilePath] -> State -> State
  > initState sty filePath ep s   =  s { style = sty,
  >                                      file = filePath,
  >                                      ofile = filePath,
  >                                      searchpath = ep,
  >                                      toggles = FM.fromList toggles0
  >                                    }
  >     where toggles0            =  --[(decode CodeOnly, Bool (sty == CodeOnly))]
  >                                  [("style", Int (fromEnum sty))]
  >                               ++ [("version", Int V.numversion)]
  >                               ++ [("pre", Int V.pre)]
  >                               ++ [("lang", Int (fromEnum (lang s)))]
  >                               ++ [ (decode s', Int (fromEnum s')) | s' <- [(minBound :: Style) .. maxBound] ]
  >                               ++ [ (decode s', Int (fromEnum s')) | s' <- [(minBound :: Lang) .. maxBound] ]
  >                               -- ++ [ (s, Bool False) || s <- ["underlineKeywords", "spacePreserving", "meta", "array", "latex209", "times", "euler" ] ]
  
  > preprocess                    :: State -> [Class] -> Bool -> [String] -> IO ()
  
  f1 is the argument to -h
  f2 is the input file
  f3 is the output file
  
  > preprocess flags dirs lit (f1:f2:f3:_)
  >                               =  if (f1 == f2) && not lit
  >                                  then copyFile f2 f3
  >                                  else do c <- readFile f2
  >                                          case matchRegex (mkRegexWithOpts "^%include" True False) c of
  >                                            Nothing -> if lit then
  >                                                          do h <- openOutputFile f3
  >                                                             lhs2TeX NewCode (flags { output = h, linefile = Just f1 }) (Directive Include "lhs2TeX.fmt" : dirs) [f2]
  >                                                             hClose h
  >                                                       else copyFile f2 f3
  >                                            Just _  -> -- supposed to be an lhs2TeX file
  >                                                       do h <- openOutputFile f3
  >                                                          lhs2TeX NewCode (flags { output = h, linefile = Just f1 }) dirs [f2]
  >                                                          hClose h
  > preprocess _ _ _ _            =  error "preprocess: too few arguments"
  
  > lhs2TeX                       :: Style -> State -> [Class] -> [String] -> IO ()
  > lhs2TeX s flags dirs files'   =  do (str, file') <- input files'
  >                                     expandedpath <- expandPath (searchpath flags)
  >                                     toIO (do put (initState s file' expandedpath flags)
  >                                              formats (map (No 0) dirs) `catchError` abort
  >                                              formatStr (addEndEOF str)
  >                                              stopexternals)
  >   where   addEndEOF           =  (++"%EOF\n") . unlines . lines
  
  > input                         :: [String] -> IO (String, FilePath)
  > input []                      =  do s <- getContents; return (s, "<stdin>")
  > input ["-"]                   =  do s <- getContents; return (s, "<stdin>")
  > input (filePath : _)          =  chaseFile [] filePath
  
  Converting command line options into directives.
  
  > uheader                       :: String
  > uheader                       =  "lhs2TeX [ options ] files\n\nAvailable options:\n"
  
  ks, 20.07.2003: The short option for @--align@ has been changed into @-A@. Otherwise
  @-align@ would not trigger compatibility mode, but be interpreted as a valid option
  usage.
  
  ks, 24.03.2004: The long option @--verbose@ has been removed for now,
  because with some versions of GHC it triggers ambiguity errors with
  @--verb@.
  
  > options                       :: [OptDescr (State -> IO State,[Class] -> [Class],[Style])]
  > options                       =
  >   [ Option ['h','?'] ["help"](NoArg (return, id, [Help]))                                 "get this help"
  >   , Option ['v'] [] {- ["verbose"] -}
  >                              (NoArg (\s -> return $ s { verbose = True }, id, []))        "be verbose"
  >   , Option ['V'] ["version"] (NoArg (return, id, [Version]))                              "show version"
  >   , Option []    ["tt"]      (NoArg (return, id, [Typewriter]))                           "typewriter style (deprecated)"
  >   , Option []    ["math"]    (NoArg (return, id, [Math]))                                 "math style (deprecated)"
  >   , Option []    ["poly"]    (NoArg (return, id, [Poly]))                                 "poly style (default)"
  >   , Option []    ["markdown"](NoArg (return, id, [Markdown]))                             "markdown style"
  >   , Option []    ["code"]    (NoArg (return, id, [CodeOnly]))                             "code style (deprecated)"
  >   , Option []    ["newcode"] (NoArg (return, id, [NewCode]))                              "new code style"
  >   , Option []    ["verb"]    (NoArg (return, id, [Verb]))                                 "verbatim (deprecated)"
  >   , Option []    ["haskell"] (NoArg (\s -> return $ s { lang = Haskell}, id, []))         "Haskell lexer (default)"
  >   , Option []    ["agda"]    (NoArg (\s -> return $ s { lang = Agda}, id, []))            "Agda lexer"
  >   , Option []    ["pre"]     (NoArg (return, id, [Pre]))                                  "act as ghc preprocessor"
  >   , Option ['o'] ["output"]  (ReqArg (\f -> (\s -> do h <- openOutputFile f
  >                                                       return $ s { output = h }, id, [])) "file") "specify output file"
  >   , Option []    ["file-directives"]
  >                              (NoArg (\s -> return $ s { fldir = True }, id, []))          "generate %file directives"
  >   , Option []    ["no-pragmas"]
  >                              (NoArg (\s -> return $ s { pragmas = False }, id, []))       "no LINE pragmas"
  >   , Option ['A'] ["align"]   (ReqArg (\c -> (return, (Directive Align c:), [])) "col")    "align at <col>"
  >   , Option ['i'] ["include"] (ReqArg (\f -> (return, (Directive Include f:), [])) "file") "include <file>"
  >   , Option ['l'] ["let"]     (ReqArg (\s -> (return, (Directive Let s:), [])) "equation") "assume <equation>"
  >   , Option ['s'] ["set"]     (ReqArg (\s -> (return, (Directive Let (s ++ " = True"):), [])) "flag")  "set <flag>"
  >   , Option ['u'] ["unset"]   (ReqArg (\s -> (return, (Directive Let (s ++ " = False"):), [])) "flag") "unset <flag>"
  >   , Option ['P'] ["path"]    (ReqArg (\p -> (\s -> return $ s { searchpath = modifySearchPath (searchpath s) p }, id , [])) "path")
  >                                                                                       "modify search path"
  >   , Option []    ["searchpath"]
  >                              (NoArg (return, id, [SearchPath]))                           "show searchpath"
  >   , Option []    ["copying"] (NoArg (return, id, [Copying]))                              "display license"
  >   , Option []    ["warranty"](NoArg (return, id, [Warranty]))                             "info about warranty"
  >   ]
  >
  > hiddenOptions                 :: [OptDescr (State -> IO State,[Class] -> [Class],[Style])]
  > hiddenOptions =
  >   [ Option []    ["texsearchpath"]
  >                              (NoArg (return, id, [TeXSearchPath]))                        "show searchpath in code environment" ]
  >
  > formatStr                     :: String -> Formatter
  > formatStr str                 =  formats (texparse 1 str) `catchError` abort
  
  Compatibility mode option handling.
  
  > cstyle                        :: [String] -> IO ()
  > cstyle args@(('-':a) : x)     =  case encode a of
  >   Just sty                    -> cstyle' sty x
  >   Nothing                     -> cstyle' Typewriter args
  > cstyle args                   =  cstyle' Typewriter args
  
  > cstyle'                       :: Style -> [String] -> IO ()
  > cstyle' s args                =  let (dirs,files') = coptions args
  >                                  in  lhs2TeX s state0 dirs files'
  
  > coptions                      :: [String] -> ([Class], [String])
  > coptions                      =  foldr (<<|) ([], [])
  >   where
  >   "-align" <<| (ds, s : as)   =  (Directive Align s : ds, as)
  >   "-i" <<| (ds, s : as)       =  (Directive Include s : ds, as)
  >   "-l" <<| (ds, s : as)       =  (Directive Let s : ds, as)
  >   ('-' : 'i' : s) <<| (ds, as)=  (Directive Include s : ds, as)
  >   ('-' : 'l' : s) <<| (ds, as)=  (Directive Let s : ds, as)
  >   s <<| (ds, as)              =  (ds, s : as)
  
  
  We abort immediately if an error has occured.
  
  > abort                         :: Exc -> Formatter
  > abort (msg, context)          =  do st <- get
  >                                     liftIO (hPutStrLn stderr (text st))
  >                                     liftIO (exitWith (ExitFailure 1))
  >     where text st             =  "*** Error in " ++ at (file st) (lineno st) ++ ": \n"
  >                               ++ unlines [ "included from " ++ at f l | (f, l) <- files st ]
  >                               ++ msg ++ "\n"
  >                               ++ unlines (take 4 (lines context))
  >           at f n              =  "file " ++ f ++ " line " ++ show n
  
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  \subsubsection{Formatting}
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  
  > formats                       :: [Numbered Class] -> Formatter
  > formats []                    =  return ()
  > formats (No n  (Directive d s) : ts)
  >     | conditional d           =  do modify (\st -> st{lineno = n})
  >                                     st <- get
  >                                     directive (lang st)
  >                                               d s (file st,n)
  >                                               (conds st) (toggles st) ts
  > formats (No n t : ts)         =  do modify (\st -> st{lineno = n})
  >                                     format t
  >                                     formats ts
  
  > format                        :: Class -> Formatter
  > -- format (Many ('%' : '%' : _))     =  return ()   -- (@%%@-comments used to be removed)
  > format (Many s)               =  out (Text s)
  > format (Inline s)             =  inline s
  > format (Command Hs s)         =  inline s
  > format (Command (Vrb b) s)    =  out (Verbatim.inline b s)
  > format (Command Eval s)       =  do st <- get
  >                                     unless (style st `elem` [CodeOnly,NewCode]) $
  >                                       do result <- external (map unNL s)
  >                                          inline result
  > format (Command Perform s)    =  do st <- get
  >                                     unless (style st `elem` [CodeOnly,NewCode]) $
  >                                       do result <- external (map unNL s)
  >                                          pushFile "<perform>"
  >                                          formatStr (addEndNL result)
  >                                          popFile
  >     where
  >     addEndNL                  =  (++"\n") . unlines . lines
  
  > format (Environment Haskell_ s)
  >                               =  display s
  > format (Environment Code s)   =  display s
  > format (Environment Spec s)   =  do st <- get
  >                                     unless (style st `elem` [CodeOnly,NewCode]) $
  >                                       display s
  > format (Environment Evaluate s)
  >                               =  do st <- get
  >                                     unless (style st `elem` [CodeOnly,NewCode]) $
  >                                       do result <- external s
  >                                          display result
  > format (Environment Hide _s)  =  return ()
  > format (Environment Ignore _s)=  return ()
  > format (Environment (Verbatim b) s)
  >                               =  out (Verbatim.display 120 b s)
  > format (Directive Format s)   =  do st <- get
  >                                     b@(_n,_e) <- fromEither (parseFormat (lang st) s)
  >                                     put (st{fmts = FM.add b (fmts st)})
  > format (Directive Subst s)    =  do st <- get
  >                                     b <- fromEither (parseSubst (lang st) s)
  >                                     put (st{subst = FM.add b (subst st)})
  > format (Directive Include arg)=  do st <- get
  >                                     let d  = path st
  >                                     let sp = searchpath st
  >                                     (str,f) <- liftIO (chaseFile sp (d ++ arg'))
  >                                     pushFile f
  >                                     modify (\st' -> st'{path = d ++ dir arg'})
  >                                     formatStr (addEndNL str)
  >                                     modify (\st' -> st'{path = d})
  >                                     popFile
  >     where arg'                =  withoutSpaces arg
  >           addEndNL            =  (++"\n") . unlines . lines
  
  ks, 25.01.2003: I added the above function at the suggestion of NAD, but
  I am not completely sure if this is the right thing to do. Maybe we should
  strip blank lines from the end of a file as well, maybe we should do nothing
  at all. Hard to say what people think is intuitive. Anyway, the reason why
  I added it is this: if an %include directive is immediately followed
  by another line and the included file does not end in a blank line, then
  there will not be a single space between the last character of the included
  file and the first character of the following line. It would be possible
  to split a TeX control sequence over two different files that way. Seems
  strange. So we add a newline, or even two if none has been there before,
  to make sure that exactly one linebreak ends up in the output, but not
  more, as a double newline is interpreted as a \par by TeX, and that might
  also not be desired.
  
  > format (Directive Begin _)    =  modify (\st -> st{stack = fmts st : stack st})
  > format (Directive End _)      =  do st <- get
  >                                     case stack st of
  >                                       [] -> do
  >                                               liftIO $
  >                                                 hPutStrLn stderr $ "unbalanced %} in line "
  >                                                   ++ show (lineno st)
  >                                       d : ds -> do
  >                                         put $ st{fmts = d, stack = ds}
  
  ks, 11.09.03: added exception handling for unbalanced grouping
  
  \Todo{|toggles| should be saved, as well.}
  
  > format (Directive Let s)      =  do st <- get
  >                                     t <- fromEither (define (lang st) (toggles st) s)
  >                                     put st{toggles = FM.add t (toggles st)}
  > format (Directive Align s)
  >     | all isSpace s           =  modify (\st -> st{align = Nothing, stacks  = ([], [])})
  >     | otherwise               =  modify (\st -> st{align = Just (read s), stacks  = ([], [])})
  
  \NB @%align@ also resets the left identation stacks.
  
  Also, the @poly@ directives @%separation@ and @%latency@ reset
  the corresponding indentation stack |pstack|.
  
  > format (Directive Separation s )
  >                               =  modify (\st -> st{separation = read s, pstack = []})
  > format (Directive Latency s)  =  modify (\st -> st{latency = read s, pstack = []})
  
  > format (Directive File s)     =  modify (\st -> st{file = withoutSpaces s})
  > format (Directive Options s)  =  modify (\st -> st{opts = trim' s})
  >     where trim'               =  dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
  
  > format (Error exc)            =  throwError exc
  > format _                      =  impossible "format"
  
  Printing documents.
  %{
  %format d1
  %format d2
  
  > eject                         :: Doc -> Formatter
  > eject Empty                   =  return ()
  > eject (Text s)                =  do  st <- get
  >                                      let (ls,enl) = checkNLs 0 s
  >                                      when (fldir st && not (null s) && atnewline st && (ofile st /= file st || olineno st /= lineno st)) $
  >                                        do  liftIO (hPutStr (output st) ("%file " ++ show (lineno st) ++ " " ++ show (file st) ++ "\n"))
  >                                            put (st { ofile = file st, olineno = lineno st })
  >
  >                                      liftIO (hPutStr (output st) s)
  >                                      modify (\st' -> st' { olineno = olineno st' + ls, atnewline = enl (atnewline st')})
  >     where
  >     checkNLs n ('\n':[])      =  (n+1,const True)
  >     checkNLs n (_:[])         =  (n,const False)
  >     checkNLs n []             =  (n,id)
  >     checkNLs n ('\n':xs)      =  checkNLs (n+1) xs
  >     checkNLs n (_:xs)         =  checkNLs n xs
  > eject (d1 :^: d2)             =  eject d1 >> eject d2
  > eject (Embedded s)            =  formatStr s
  > eject (Sub s ds)              =  do st <- get; substitute (subst st)
  >     where
  >     substitute d              =  case FM.lookup s d of
  >         Nothing               -> throwError (undef s, "")
  >         Just sub              -> eject (sub ds)
  >
  > undef                         :: String -> String
  > undef s                       =  "`" ++ s ++ "' is not defined;\n\
  >                                  \perhaps you forgot to include \"polycode.fmt\" (or \"lhs2TeX.fmt\")?"
  
  %}
  
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  \subsubsection{Source file handling}
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  
  Helper functions to maintain the state when we temporarily process another file,
  which can be either a virtual file (during perform calls) or an explicitly included
  file.
  
  > pushFile :: FilePath -> Formatter
  > pushFile filename = do
  >   st <- get
  >   put $ st{file = filename, files = (file st, lineno st) : files st}
  >   liftIO (when (verbose st) (hPutStr stderr $ "(" ++ filename))
  
  > popFile :: Formatter
  > popFile = do
  >   st <- get
  >   case files st of
  >     [] -> pure () -- should ideally not occur when this function is called
  >     (f, l) : fs' -> put $ st{file = f, lineno = l, files = fs'}
  >   liftIO (when (verbose st) (hPutStrLn stderr $ ")"))
  
  In a relatively naive way, determine the directory part of a filename. Set up
  in such a way that the returned path should be empty or end in a slash.
  
  > dir                           :: FilePath -> FilePath
  > dir filePath
  >     | null d                  =  ""
  >     | otherwise               =  reverse d
  >     where d                   =  dropWhile (/= '/') (reverse filePath)
  
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  \subsubsection{Style dependent formatting}
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  
  > out                           :: Doc -> Formatter
  > out d                         =  do st <- get; eject (select (style st))
  >     where select CodeOnly     =  Empty
  >           select NewCode      =  Empty
  >           select _            =  d
  
  > inline, display               :: String -> Formatter
  > inline s                      =  do st <- get
  >                                     d <- fromEither (select (style st) st)
  >                                     eject d
  >   where select Verb _st       =  Right (Verbatim.inline False s)
  >         select Typewriter st  =  Typewriter.inline (lang st) (fmts st) s
  >         select Math st        =  Math.inline (lang st) (fmts st) (isTrue (toggles st) auto) s
  >         select Poly st        =  Poly.inline (lang st) (fmts st) (isTrue (toggles st) auto) s
  >         select Markdown st    =  NewCode.inline (lang st) (fmts st) s
  >         select CodeOnly _st   =  return Empty
  >         select NewCode _st    =  return Empty   -- generate PRAGMA or something?
  >         select _ _            =  impossible "inline.select"
  
  > display s                     =  do st <- get
  >                                     (d, st') <- fromEither (select (style st) st)
  >                                     put st'
  >                                     eject d
  >   where select Verb st        =  return (Verbatim.display 120 False s, st)
  >         select Typewriter st  =  do d <- Typewriter.display (lang st) (fmts st) s; return (d, st)
  >         select Math st        =  do (d, sts) <- Math.display (lang st) (fmts st) (isTrue (toggles st) auto) (stacks st) (align st) s
  >                                     return (d, st{stacks = sts})
  >         select Poly st        =  do (d, pstack') <- Poly.display (lang st) (lineno st + 1) (fmts st) (isTrue (toggles st) auto) (separation st) (latency st) (pstack st) s
  >                                     return (d, st{pstack = pstack'})
  >         select NewCode st     =  do d <- NewCode.display (lang st) (fmts st) s
  >                                     -- display trims the contents, so for the line number in the pragma to be correct, we have to check initial newlines
  >                                     let nlOffset = newlines (takeWhile isSpace s)
  >                                     let p = sub'pragma $ Text ("LINE " ++ show (lineno st + nlOffset) ++ " " ++ show (fromMaybe (takeFileName $ file st) (linefile st)))
  >                                     return ((if pragmas st then ((p <<>> sub'nl) <<>>) else id) d, st)
  >         select Markdown st    =  do d <- NewCode.display (lang st) (fmts st) s
  >                                     return (d, st)
  >         select CodeOnly st    =  return (Text (trim s), st)
  >         select _ _            =  impossible "display.select"
  
  > auto                          :: String
  > auto                          =  "autoSpacing"
  > isTrue                        :: Toggles -> String -> Bool
  > isTrue togs s                 =  bool (value togs s)
  
  Delete leading and trailing blank line (only the first!).
  
  > trim                          :: String -> String
  > trim                          =  skip' >>> reverse >>> skip' >>> reverse
  >     where
  >     skip'                     :: String -> String
  >     skip' ""                  =  ""
  >     skip' s | all isSpace t   =  u
  >            | otherwise        =  s
  >            where (t, u)       =  breakAfter (== '\n') s
  
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  \subsubsection{Conditional directives}
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  
  A stack of Boolean values holds the conditions of
  @%if@-directives.  Perhaps surpsingly, each @%if@ gives rise
  to \emph{two} entries; if @%elif@ is not used the second entry is
  always |True|, otherwise it holds the negation of all previous
  conditions of the current @%if@-chain.
  
  ks, 16.08.2004: At the end of the input, we might want to check for unbalanced if's or
  groups.
  
  > directive                     :: Lang -> Directive -> String
  >                               -> (FilePath,LineNo) -> [CondInfo] -> Toggles
  >                               -> [Numbered Class] -> Formatter
  > directive lang' d0 s0 (f0,l0) stack' togs ts
  >                               =  dir' d0 s0 stack'
  >   where
  >   dir' If s bs                =  do b <- fromEither (eval lang' togs s)
  >                                     skipOrFormat ((f0, l0, bool b, True) : bs) ts
  >   dir' Elif s ((f,l,b2,b1):bs)=  do b <- fromEither (eval lang' togs s)
  >                                     skipOrFormat ((f, l, bool b, not b2 && b1) : bs) ts
  >   dir' Else _ ((f,l,b2,b1):bs)=  skipOrFormat ((f, l, not b2 && b1, True) : bs) ts
  >   dir' Endif _ ((_f,_l,_b2,_b1):bs)=  skipOrFormat bs ts
  >   dir' EOF _ []               =  return ()  -- nothing left to do
  >   dir' EOF s bs               =  throwError (init $ unlines (map unBalancedIf bs), s)
  >   dir' d s _                  =  throwError ("spurious %" ++ decode d, s)
  
  > skipOrFormat                  :: [CondInfo] -> [Numbered Class] -> Formatter
  > skipOrFormat stack' ts        =  do  modify (\st -> st{conds = stack'})
  >                                      if andS stack'  then formats ts
  >                                                      else skip ts
  
  > andS                          :: [CondInfo] -> Bool
  > andS                          =  all (\(_,_,x,y) -> x && y)
  
  > unBalancedIf                  :: CondInfo -> String
  > unBalancedIf (f,l,_,_)        =  "%if at " ++ f ++ " line " ++ show l ++ " not closed"
  
  > skip                          :: [Numbered Class] -> Formatter
  > skip []                       =  return ()
  > skip ts@(No _n (Directive d _s) : _)
  >     | conditional d           =  formats ts
  > skip (_t : ts)                =  skip ts
  
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  \subsubsection{Active commands}
  % - - - - - - - - - - - - - - - = - - - - - - - - - - - - - - - - - - - - - - -
  
  ks, 23.10.2003: extended to work with @ghci@, too.
  ks, 03.01.2004: fixed to work with @ghci-6.2@, hopefully without breaking
  @hugs@ or old @ghci@ compatibility.
  
  New, 26.01.2006: we're now starting an external process @ghci@ or @hugs@
  using the System.Process library. The process is then reused for subsequent
  computations, which should dramatically improve compilation time for
  documents that make extensive use of @\eval@ and @\perform@.
  
  The function |external| can be used to call the process. It is discouraged
  to call any programs except @ghci@ or @hugs@, because we make a number of
  assumptions about the program being called. Input is the expression to evaluate.
  Output is the result in string form.
  
  > external                      :: String -> XIO Exc State String
  > external expr                 =  do st <- get
  >                                     let os  =  opts st
  >                                         f   =  file st
  >                                         ex  =  externals st
  >                                         ghcimode       =  "ghci" `isPrefixOf` os
  >                                         cmd
  >                                           | ghcimode   =  os ++ " -v0 -ignore-dot-ghci " ++ f
  >                                           | otherwise  =  (if null os then "hugs " else os ++ " ") ++ f
  >                                         script         =  "putStrLn " ++ show magic ++ "\n"
  >                                                             ++ expr ++ "\n"
  >                                                             ++ "putStrLn " ++ show magic ++ "\n"
  >                                     pi <- case FM.lookup f ex of
  >                                             Just pi  ->  return pi
  >                                             Nothing  ->  -- start new external process
  >                                                          liftIO $ do
  >                                                            when (verbose st) $
  >                                                              hPutStrLn stderr $ "Starting external process: " ++ cmd
  >                                                            runInteractiveCommand cmd
  >                                     put (st {externals = FM.add (f,pi) ex})
  >                                     let (pin,pout,_,_) = pi
  >                                     liftIO $ do
  >                                       -- hPutStrLn stderr ("sending: " ++ script)
  >                                       hPutStr pin script
  >                                       hFlush pin
  >                                       extract' pout
  
  This function can be used to stop all external processes by sending the
  @:q@ command to them.
  
  > stopexternals                 :: Formatter
  > stopexternals                 =  do st <- get
  >                                     let ex   =  externals st
  >                                         pis  =  map (ex FM.!) (FM.keys ex)
  >                                     when (not . null $ pis) $ liftIO $ do
  >                                       when (verbose st) $
  >                                         hPutStrLn stderr $ "Stopping external processes."
  >                                       mapM_ (\(pin,_,_,pid) -> do  hPutStrLn pin ":q"
  >                                                                    hFlush pin
  >                                                                    waitForProcess pid) pis
  
  To extract the answer from @ghci@'s or @hugs@' output
  we use a simple technique which should work in
  most cases: we print the string |magic| before and after
  the expression we are interested in. We assume that everything
  that appears before the first occurrence of |magic| on the same
  line is the prompt, and everything between the first |magic|
  and the second |magic| plus prompt is the result we look for.
  
  > magic                         :: String
  > magic                         =  "!@#$^&*"
  >
  > extract'                      :: Handle -> IO String
  > extract' h                    =  fmap (extract . unlines) (readMagic 2)
  >     where readMagic           :: Int -> IO [String]
  >           readMagic 0         =  return []
  >           readMagic n         =  do  l <- hGetLine h
  >                                      -- hPutStrLn stderr ("received: " ++ l)
  >                                      let n'  |  (null . snd . breaks (isPrefixOf magic)) l  =  n
  >                                              |  otherwise                                   =  n - 1
  >                                      fmap (l:) (readMagic n')
  
  > extract                       :: String -> String
  > extract s                     =  v
  >     where (t, u)              =  breaks (isPrefixOf magic) s
  >           -- t contains everything up to magic, u starts with magic
  >           -- u'                      =  tail (dropWhile (/='\n') u)
  >           pre                 =  reverse . takeWhile (/='\n') . reverse $ t
  >           prelength           =  if null pre then 0 else length pre + 1
  >           -- pre contains the prefix of magic on the same line
  >           u'                  =  drop (length magic + prelength) u
  >           -- we drop the magic string, plus the newline, plus the prefix
  >           (v, _)              =  breaks (isPrefixOf (pre ++ magic)) u'
  >           -- we look for the next occurrence of prefix plus magic
  
  