content: {- |
  Module      :  ./utils/itcor/GenItCorrections.hs
  Copyright   :  (c) C. Maeder, DFKI GmbH 2010
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  Christian.Maeder@dfki.de
  Stability   :  experimental
  Portability :  portable
  
  -}
  
  module Main where
  
  import Text.ParserCombinators.Parsec
  import qualified Data.Map as Map
  import System.Environment
  import System.Exit
  import System.Cmd
  import Control.Monad
  import qualified Control.Monad.Fail as Fail
  
  usage :: IO ()
  usage = putStrLn
            "Usage: it-corrections \"gen_it_characters\" \"gen_it_words\""
  
  main :: IO ()
  main = do
    args <- getArgs
    case args of
     [] -> usage
     [_] -> usage
     [fp1_base, fp2_base] -> do
         let fp1 = fp1_base ++ ".txt"
             fp2 = fp2_base ++ ".txt"
             fp1_tex = fp1_base ++ ".tex"
             fp2_tex = fp2_base ++ ".tex"
             fp1_pdf = fp1_base ++ ".pdf"
             fp2_pdf = fp2_base ++ ".pdf"
         generate_tex_files fp2_tex fp1_tex
         convert_to_txt fp1_tex fp1_pdf
         convert_to_txt fp2_tex fp2_pdf
         str1 <- readFile fp1        -- file with table for every character
         p1 <- parseItTable str1
         str2 <- readFile fp2        -- file with table for combinated characters
         p2 <- parseItTable str2
         let itc = corrections (Map.fromList (zip allCharacters p1))
                            (zip combinations p2)
         str <- output itc ""  -- print itc
         putStrLn ("\nitaliccorrection_map :: Map String Int\n" ++
                   "italiccorrection_map = fromList $ read " ++ post_proc str )
     _ -> usage
  
  convert_to_txt :: FilePath -> FilePath -> IO ()
  convert_to_txt tex_name pdf_name = do
    system ("pdflatex -interaction=batchmode " ++ tex_name ++ " >/dev/null") >>=
            \ ec -> when (isFail ec) (Fail.fail "pdflatex went wrong")
    rawSystem "pdftotext" ["-raw", "-q", pdf_name] >>=
            \ ec -> when (isFail ec) (Fail.fail "pdftotext went wrong")
    return ()
    where isFail ec = case ec of
                        ExitFailure _ -> True
                        _ -> False
  
  generate_tex_files :: String -> String -> IO ()
  generate_tex_files filename1 filename2 = do
    writeFile filename1 (tex_file $ writeTexTable combinations)
    writeFile filename2 (tex_file $ writeTexTable [[c] | c <- allCharacters])
  
  output :: [(String, Int)] -> String -> IO String
  output [] str = return (init str)
  output ((s, i) : xs) str =
      output xs $ str ++ "(\"" ++ s ++ "\"," ++ show i ++ "),"
  
  post_proc :: String -> String
  post_proc str = '\"' : '[' : concatMap conv str ++ "]\""
      where conv c = case c of
                     '\"' -> "\\\""
                     -- substitute umlauts with \196\214\220\223\228\246\252
                     '\196' -> "\\196"
                     '\214' -> "\\214"
                     '\220' -> "\\220"
                     '\223' -> "\\223"
                     '\228' -> "\\228"
                     '\246' -> "\\246"
                     '\252' -> "\\252"
                     _ -> [c]
  
  -- -------- Parser for Table generated with "width-it-table.tex" ---------
  parseItTable :: String -> IO [Double]
  parseItTable str = case parse itParser "" str of
      Left err -> do
        putStr "parse error at"
        print err; error ""
      Right x -> return x
  
  
  itParser :: Parser [Double]
  itParser = do
      manyTill anyChar (try (string "wl: "))
      many1 tableEntry
    <|> do
      anyChar
      itParser
  
  
  tableEntry :: Parser Double
  tableEntry = do
      str <- parseDouble
      string "pt"
      spaces
      try (manyTill anyChar $ try $ string "wl: ") <|> manyTill anyChar eof
      return (read str)
  
  parseDouble :: Parser String
  parseDouble = many1 double
  
  double :: Parser Char
  double = digit <|> char '.'
  
  stringHead :: Parser String
  stringHead = do
    c1 <- tableChar
    c2 <- option "" tableChar
    return (c1 ++ c2)
  
  tableChar :: Parser String
  tableChar = do
    str <- try letter <|> digit
    return [str]
  
  -- ------------------------------------------------------------------------
  
  corrections :: Map.Map Char Double -> [(String, Double)] -> [(String, Int)]
  corrections fm = map (corrections' fm)
  
  corrections' :: Map.Map Char Double -> (String, Double) -> (String, Int)
  corrections' fm (str, d) = case str of
    [c1, c2] ->
      let d1 = Map.findWithDefault 0.0 c1 fm
          d2 = Map.findWithDefault 0.0 c2 fm
          dif = round (((d1 + d2) - d) * 0.351 * 1000.0)
      in (str, dif)
    _ -> error "corrections'"
  
  combinations :: [String]
  combinations = let z = zipIt allCharacters allCharacters
                 in [ c1 : [c2] | (c1, c2) <- z ]
                 where
                 zipIt :: String -> String -> [(Char, Char)]
                 zipIt [] _ = []
                 zipIt (a : as) bs = zip [a, a ..] bs ++ zipIt as bs
  
  allCharacters :: String
  allCharacters = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9']
                  ++ "\228\252\246\196\220\214\223"
  
  writeTexTable :: [String] -> String
  writeTexTable [] = []
  writeTexTable strl = concat
      [ "\\wordline{\\textit{" ++ str ++ "}}\n\\hline\n" | str <- f ]
      ++ "\\end{tabular}\n\\newpage\n\\begin{tabular}{l|l}\n\\hline\n"
      ++ writeTexTable r
      where (f, r) = splitAt 30 strl
  
  
  tex_file :: String -> String
  tex_file str = unlines
    [ "\\documentclass[a4paper]{article}"
    , "\\usepackage{bookman}"
    , "\\usepackage[latin1]{inputenc}"
    , "\\usepackage{german}"
    , "\\usepackage{calc}"
    , "\\usepackage{longtable}"
    , "\\newlength{\\widthofword}"
    , "\\setlength{\\parindent}{0cm}"
    , "\\newcommand{\\wordline}[1]%"
    , "{#1 & wl: \\setlength{\\widthofword}{\\widthof{#1}}\\the\\widthofword\\\\}"
    , "\\title{Useful Widths for Typesetting-CASL}"
    , "\\author{Klaus Luettich}"
    , "\\begin{document}"
    , "\\maketitle"
    , "\\begin{tabular}{l|l}"
    , "\\hline"
    , str
    , "\\end{tabular}"
    , "\\end{document}" ]
  