  | 
 Module       :   ./utils / itcor / GenItCorrections.hs 
 Copyright    :   ( c )   , DFKI GmbH 2010 
 License      :   GPLv2 or higher , see LICENSE.txt 

 Maintainer   :    
 Stability    :   experimental 
 Portability :   portable 


Module      :  ./utils/itcor/GenItCorrections.hs
Copyright   :  (c) C. Maeder, DFKI GmbH 2010
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  
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' -> "\\196"
                   '\214' -> "\\214"
                   '\220' -> "\\220"
                   '\223' -> "\\223"
                   '\228' -> "\\228"
                   '\246' -> "\\246"
                   '\252' -> "\\252"
                   _ -> [c]

  --------  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}" ]

 file with table for every character
 file with table for combinated characters
 print itc
------  for Table generated with " width-it-table.tex " ---------
 ------------------------------------------------------------------------
  | 
 Module       :   ./utils / itcor / GenItCorrections.hs 
 Copyright    :   ( c )   , DFKI GmbH 2010 
 License      :   GPLv2 or higher , see LICENSE.txt 

 Maintainer   :    
 Stability    :   experimental 
 Portability :   portable 


Module      :  ./utils/itcor/GenItCorrections.hs
Copyright   :  (c) C. Maeder, DFKI GmbH 2010
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  
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
       p1 <- parseItTable str1
       p2 <- parseItTable str2
       let itc = corrections (Map.fromList (zip allCharacters p1))
                          (zip combinations p2)
       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' -> "\\196"
                   '\214' -> "\\214"
                   '\220' -> "\\220"
                   '\223' -> "\\223"
                   '\228' -> "\\228"
                   '\246' -> "\\246"
                   '\252' -> "\\252"
                   _ -> [c]

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}" ]
