content: import MkExxTable
  import System.Process(system)
  import System.FilePath((</>),(<.>))
  import Data.Char
  import Data.List
  import qualified Data.Map as M
  import Text.Printf
  import Config (loadLangsFrom, LangInfo (..))
  import qualified Config
  
  type Cats = [(String,String,String)]
  type Rules = [(String,String,String)]
  
  -- the file generated
  outfile :: FilePath
  outfile = "index.txt"
  
  -- the languages.csv config file
  configFile :: FilePath
  configFile = ".." </> ".." </> Config.configFile
  
  -- the language in which revealed examples are shown
  revealedLang :: String
  revealedLang = "Eng"
  
  -- | This function puts together a txt2tags file which is then converted to HTML by the Makefile
  main :: IO ()
  main = do
    langs <- loadLangsFrom configFile >>= return . filter langSynopsis
    cs1 <- getCats commonAPI
    cs2 <- getCats catAPI
    let cs = sortCats (cs1 ++ cs2)
    writeFile outfile "GF Resource Grammar Library: Synopsis"
    space
    append "%!Encoding:utf-8"
    append "%!postproc(html): '#divreveal'  '<div class=reveal>'"
    append "%!postproc(html): '#divpopup'  '<div class=popup>'"
    append "%!postproc(html): '#ediv'  '</div>'"
    append "%!postproc(html): '#UL'  '<ul>'"
    append "%!postproc(html): '#EUL'  '</ul>'"
    append "%!postproc(html): '#LI'  '<li>'"
    append "%!postproc(html): '#LParadigms'  '<a name=\"RParadigms\"></a>'"
    append ("%!postproc(html): '#LANGUAGE_COUNT'  '" ++ show (length langs) ++ "'")
    append ("%!postproc(html): '#LANGUAGES'  '" ++ intercalate ", " (map langName langs) ++ ".'")
    delimit $ addToolTips cs
    include "intro.txt"
    space
    title "Categories"
    space
    link "Source 1:" commonAPI
    space
    link "Source 2:" catAPI
    space
    stitle "A hierarchic view"
    space
    include "categories-intro.txt"
    stitle "Explanations"
    space
    delimit $ mkCatTable cs
    space
    title "Syntax Rules and Structural Words"
    space
    link "Source 1:" syntaxAPI
    space
    link "Source 2:" structuralAPI
    space
    apiExx <- getApiExx (apiExxFiles langs)
    rs <- getRules apiExx syntaxAPI
    rs2 <- getRules apiExx structuralAPI
    let rss = rs ++ rs2
    delimit $ mkSplitTables True apiExx cs rss
    space
  --  title "Structural Words"
  --  space
  --  link "Source:" structuralAPI
  --  space
  --  rs <- rulesTable False cs structuralAPI
  --  delimit rs
    space
    title "Lexical Paradigms"
    append "#LParadigms"
    mapM_ (putParadigms cs) (paradigmFiles langs)
    space
    include "additional.txt"
    space
    include "browse.txt"
    space
    title "An Example of Usage"
    space
    include "example.txt"
    space
    title "Table of Contents"
    space
    append "%%toc"
    space
  
  addToolTips :: Cats -> [String]
  addToolTips = map f
    where f (n,e,_) = "%!postproc(html): '(?i)(HREF=\"#" ++ n ++ "\")( TITLE=\"[^\"]*\")?'  '\\1 TITLE=\"" ++ e' ++ "\"'"
             where e' = n ++ if null e then "" else " - " ++ e
  
  getCats :: FilePath -> IO Cats
  getCats file = do
    ss <- readFile file >>= return . lines
    return $ getrs [] ss
   where
     getrs rs ss = case ss of
       ('-':'-':'.':_):_ -> reverse rs
       [] -> reverse rs
       ('-':'-':_):ss2 -> getrs rs ss2
       s:ss2 -> case words s of
         cat:";":"--":exp -> getrs ((cat,unwords expl, unwords (tail ex)):rs) ss2 where
           (expl,ex) = span (/="e.g.") exp
         _ -> getrs rs ss2
  
  rulesTable :: ApiExx -> Bool -> Cats -> FilePath -> IO [String]
  rulesTable aexx hasEx cs file = do
    rs <- getRules aexx file
    return $ mkTable hasEx aexx cs rs
  
  
  getRules :: ApiExx -> FilePath -> IO Rules
  getRules aexx file = do
    ss <- readFileC (coding file) file >>= return . filter (not . hiddenLine) . lines
    return $ getrs [] ss
   where
     getrs rs ss = case ss of
       ('-':'-':'.':_):_ -> reverse rs
       [] -> reverse rs
       ('-':'-':_):ss2 -> getrs rs ss2
       s:ss2 -> case words s of
         _:_:"overload":_ -> getrs rs ss2
         _:":":_ -> getrs (rule s:rs) ss2
         _ -> getrs rs ss2
     rule s = (name, typ, ex)
         where
           ws = takeWhile (flip notElem ["--#", "--:", "="]) $ words s
           name = head ws
           (t,e) = span (/="--") (tail ws)
           typ = unwords $ filtype (drop 1 t)
           filtype = filter (/=";")
           ex = if null e then "" else unwords $ unnumber $ drop 1 e
           unnumber e = case e of
             n:ws | last n == '.' && not (null (init n)) && all isDigit (init n) -> ws
             _ -> e
  
  putParadigms :: Cats -> (String, FilePath) -> IO ()
  putParadigms cs (lang,file) = do
    stitle ("Paradigms for " ++ lang)
    space
    link "source" file
    space
    rs <- rulesTable M.empty False cs file
    space
    delimit rs
    space
  
  inChunks :: Int -> ([a] -> [String]) -> [a] -> [String]
  inChunks i f = concat . intersperse ["\n\n"] . map f . chunks i where
    chunks _ [] = []
    chunks i xs = x : chunks i y where (x,y) = splitAt i xs
  
  -- Makes one table per result category.
  -- Adds a subsection header for each table.
  mkSplitTables :: Bool -> ApiExx -> Cats -> Rules -> [String]
  mkSplitTables hasEx aexx cs = concatMap t . addLexicalCats cs . sortRules
    where t (c, xs) = [subtitle c expl, "\n"] ++ tableOrLink
           where
             expl = case [e | (n,e,_) <- cs, n == c] of
                          []  -> ""
                          e:_ -> e
             tableOrLink = if null xs then parad else mkTable hasEx aexx cs xs
             parad = [
               "Lexical category, constructors given in",
               "[lexical paradigms #RParadigms]."
               ]
  
  mkTable :: Bool -> ApiExx -> Cats -> Rules -> [String]
  mkTable hasEx aexx cs = inChunks chsize (\rs -> header : map (unwords . row) rs)
   where
    chsize = 1000
    header = if hasEx then "|| Function  | Type  | Example  |"
                      else "|| Function  | Type  | Explanation |"
    row (name,typ,ex) =
           let ntyp = mkIdent (name ++ " : " ++ typ) in
           if hasEx then ["|", name', "|", typ', "|", ex' ntyp, "|"]
                    else ["|", name', "|", typ', "|", expl ntyp, "|"]
     where
       name' = ttf name
       typ' = showTyp cs typ
       ex' typ = let ex0 = if null ex then itf (takeWhile (/='_') name) else ex in
             case M.lookup typ aexx of
               Just es -> mkExample es ex0
               _ -> itf ex0
       expl typ = if null ex then itf "-" else itf ex
  
  -- make an example with hover-popup translations
  mkExample :: M.Map String String -> String -> String
  mkExample es ex = unwords [
    "#divreveal",
    itf (maybe ex (mkEx revealedLang) (M.lookup revealedLang es)),
    "#divpopup",
    "#UL",
    unwords ["#LI" ++ e | e <- prApiEx es],
    "#EUL",
    "#ediv",
    "#ediv"
    ]
  
  -- makes mkUtt : QS -> Utt to mkUtt-QS-Utt
  mkIdent :: String -> String
  mkIdent = concatMap unspec where
    unspec c = case c of
      ' ' -> ""
      '>' -> ""
      '(' -> ""
      ')' -> ""
      ':' -> "-"
      _   -> [c]
  
  mkCatTable :: Cats -> [String]
  mkCatTable cs = inChunks chsize (\rs -> header ++ map mk1 rs) cs
   where
    header = ["|| Category  | Explanation  | Example  |"]
    chsize = 1000
    mk1 (name,expl,ex) = unwords ["|", showCat cs name, "|", expl, "|", typo ex, "|"]
    typo ex = if take 1 ex == "\"" then itf (init (tail ex)) else ex
  
  srcPath :: FilePath -> FilePath
  srcPath = ((</>) "../../src")
  
  commonAPI = srcPath "abstract/Common.gf"
  catAPI    = srcPath "abstract/Cat.gf"
  syntaxAPI = srcPath "api/Constructors.gf"
  structuralAPI = srcPath "abstract/Structural.gf"
  
  -- all languages shown (a copy of this list appears in Makefile)
  apiExxFiles :: [LangInfo] -> [FilePath]
  apiExxFiles langs =
    [ "api-examples-" ++ (langCode lang) ++ ".txt"
    | lang <- langs
    ]
  
  paradigmFiles :: [LangInfo] -> [(String,FilePath)]
  paradigmFiles langs =
    [ (langName lang, srcPath $ printf "%s/Paradigms%s.gf" (langDir lang) (langCode lang))
    | lang <- langs
    ]
  
  -- | Split a string at given character, similar to words
  splitOn :: (Char -> Bool) -> String -> [String]
  splitOn _ "" = []
  splitOn f s = takeWhile (not.f) s : splitOn f rest
    where
      rest = case dropWhile (not.f) s of
        "" -> []
        _:xs -> xs
  
  append s = appendFile outfile ('\n':s)
  title s = append $ "=" ++ s ++ "="
  stitle s = append $ "==" ++ s ++ "=="
  include s = append $ "%!include: " ++ s
  space = append "\n"
  delimit ss = mapM_ append ss
  link s f = append $ s ++ " [``" ++ f ++ "`` " ++ f ++ "]"
  
  ttf s = "``" ++ s ++ "``"
  itf s = "//" ++ s ++ "//"
  
  hiddenLine :: String -> Bool
  hiddenLine s = case reverse (words s) of
    "--%":_ -> True
    _ -> False
  
  -----------------
  
  -- sort category synopsis by category, retain one table
  sortCats :: Cats -> Cats
  sortCats = sortBy compareCat
    where compareCat (n1,_,_) (n2,_,_) = compare n1 n2
  
  -- sort function synopsis by category, into separate tables
  sortRules :: Rules -> [Rules]
  sortRules = groupBy sameCat . sortBy compareRules
    where sameCat r1 r2 = resultCat r1 == resultCat r2
          compareRules r1@(n1,_,_) r2@(n2,_,_)
              = compare (resultCat r1,n1) (resultCat r2,n2)
  
  addLexicalCats :: Cats -> [Rules] -> [(String,Rules)]
  addLexicalCats cs rss =
      map head $ groupBy fstEq $ sortBy (\x y -> compare (fst x) (fst y)) $
             [ (resultCat r, rs) | rs@(r:_) <- rss] ++ [(n,[]) | (n,_,_) <- cs]
    where fstEq p1 p2 = fst p1 == fst p2
  
  resultCat :: (String,String,String) -> String
  resultCat (_,t,_) = last (words t)
  
  subtitle :: String -> String -> String
  subtitle cat expl = "==" ++ cat ++ e ++ "==" ++ "[" ++ cat ++ "]"
    where e = if null expl then "" else " - " ++ expl
  
  showCat :: Cats -> String -> String
  showCat cs cat = "[" ++ cat ++ " #" ++ cat ++ "]"
  
  showTyp :: Cats -> String -> String
  showTyp cs = unwords . map f . words
    where f s | head s == '(' && last s == ')' && isCat c
                  = "(" ++ showCat cs c ++ ")"
              | isCat s = showCat cs s
              | otherwise = ttf s
           where c = init (tail s)
          isCat cat = cat `notElem` ["Str","Int"]
                      && all (\c -> isAlphaNum c || c == '\'') cat
                      && isUpper (head cat)
  
  -- to work around GHC 6.12 file input
  readFileC :: String -> FilePath -> IO String
  readFileC cod file = do
    let tmp = file <.> "tmp"
    case cod of
      "utf8" -> readFile file
      _ -> do
        system $ "iconv -f " ++ cod ++ " -t UTF-8 " ++ file ++ " >" ++ tmp
        readFile tmp
  
  -- 'intelligently' determine the coding of a file
  ---- AR 5/6/2016: now utf8 is used for all languages except Bul, where no characters are shown in documentation anyway
  coding :: FilePath -> String
  coding file = case language file of
    "Bul" -> "CP1251" --- "ISO-8859-1"
    _     -> "utf8"
    where
      language = reverse . take 3 . drop 3 . reverse
  