----------------------------------------------------------------------
-- |
-- Maintainer  : AR
-- Stability   : (stable)
-- Portability : (portable)
--
-- > CVS $Date: 2005/05/16 17:07:18 $ 
-- > CVS $Author: aarne $
-- > CVS $Revision: 1.11 $
--
-- chop an HTML file into separate files, each linked to the next and previous.
-- the names of the files are n-file, with n = 01,02,...
-- the chopping is performed at each separator, here defined as @\<!-- NEW --\>@
--
-- AR 7\/1\/2002 for the Vinnova meeting in Linköping.
-- Added table of contents generation in file 00, 16/4/2005
-----------------------------------------------------------------------------

module Main (main) where

import System
import Char

main :: IO ()
main = do
  file:_ <- getArgs
  htmls file

htmls :: FilePath -> IO ()
htmls file = do
  s  <- readFile file
  let ss = allPages file s
      lg = length ss
  putStrLn $ show lg ++ " slides"
  mapM_ (uncurry writeFile . mkFile file lg) ss

allPages :: FilePath -> String -> [(Int,String)]
allPages file s = addIndex $ zip [1..] $ map unlines $ chop lss where
  chop ls = case span isNoSep ls of
      (s,_:ss) -> s : chop ss
      _ -> [ls]                 
  isNoSep = (/= separator)
  addIndex = ((0,mkIndex file lss) :) 
  lss = lines s

mkFile :: FilePath -> Int -> (Int,String) -> (FilePath,String)
mkFile base mx (number,content) = 
 (fileName base number,
  unlines [
    begHTML,
    "<font size=1>",
    pageNum mx number,
    link base mx number,
    "</font>",
    "<p>",
    content,
    endHTML
   ]
  )

begHTML, endHTML, separator :: String
begHTML   = "<html><body bgcolor=\"#FFFFFF\" text=\"#000000\">"
endHTML   = "</body></html>"
separator = "<!-- NEW -->"

link :: FilePath -> Int -> Int -> String
link file mx n = 
  (if n >= mx-1 then "" else ("   <a href=\"" ++ file' ++ "\">Next</a>")) ++
  (if n == 1  then "" else ("   <a href=\"" ++ file_ ++ "\">Previous</a>")) ++
                           ("   <a href=\"" ++ file0 ++ "\">Contents</a>") ++
                           ("   <a href=\"" ++ file  ++ "\">Fulltext</a>") ++
                           ("   <a href=\"" ++ file1 ++ "\">First</a>") ++
                           ("   <a href=\"" ++ file2 ++ "\">Last</a>")
  where
    file_ = fileName file (n - 1)
    file' = fileName file (n + 1)
    file0 = fileName file 0
    file1 = fileName file 1
    file2 = fileName file (mx - 1)

fileName :: FilePath -> Int -> FilePath
fileName file n = (if n < 10 then ('0':) else id) $ show n ++ "-" ++ file

pageNum mx num = "<p align=right>" ++ show num ++"/" ++ show (mx-1) ++ "</p>"

mkIndex file = unlines . mkInd 1 where
  mkInd n ss = case ss of
    s : rest | (s==separator) -> mkInd (n+1) rest
    s : rest -> case getHeading s of
      Just (i,t) -> mkLine n i t : mkInd n rest
      _ -> mkInd n rest
    _ -> []
  getHeading s = case dropWhile isSpace s of
    '<':h:i:_:t | isDigit i -> return (i,take (length t - 5) t)  -- drop final </hi>
    _ -> Nothing
  mkLine _ '1' t = t ++ " : Table of Contents<p>"       -- heading of whole document
  mkLine n i t = stars i ++ link n t ++ "<br>"
  stars i = case i of
    '3' -> "<li> "
    '4' -> "<li>* "
    _   -> ""
  link n t = "<a href=\"" ++ fileName file n ++ "\">" ++ t ++ "</a>"
