import System.Process(system)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List


-- building a table of RGL functions and their types, examples, and documentation
-- to run:
--   $ runghc AbsFunDoc.hs >absfuns.txt
--   $ txt2tags -thtml absfuns.txt
-- this creates the file absfuns.html

main = do
  system "grep \" : \" ../src/abstract/*.gf ../src/translator/Extensions.gf >absfuns.tmp"
  funs <- readFile "absfuns.tmp" >>= return . lines
  deps <- readFile "../src/uddeps.labels" >>= return . lines
  let depmap = M.fromList [(fun,deps) | fun:deps <- map words deps]
  let rows = sort $ filter (flip S.notMember hiddenModules . last) $ map (mkRow depmap) (map words funs)
  let entries = map sepFields rows
  putStrLn $ "GF RGL Functions"
  putStrLn $ "generated by lib/src/doc/AbsFunFoc.hs"
  putStrLn $ ""
  putStrLn $ sepFields ["Function","Type","Example","Dependencies","Module"]
  putStrLn $ unlines entries


hiddenModules = S.fromList
  ["Backward","Structural","Extra","Construction","Compatibility",
   "Documentation","Lexicon","NumeralTransfer","Terminology","Transfer","MarkHTML","Markup","ERROR"] ----

mkRow depmap ws = case ws of
  file:fun:":":typecomment -> fun : getTypeComment typecomment ++ [getDep fun, getModule file]
  _ -> ["ERROR"]
 where
   getModule = reverse . takeWhile (/='/') . tail . dropWhile (/='.') . reverse -- ../src/abstract/Adverb.gf: --> Adverb
   getTypeComment ws = case span (/= ";") ws of
     (ty,rest) -> [unwords ty, unwords (drop 2 rest)]  -- PredVP    : NP -> VP -> Cl ; -- John walks
   getDep fun = maybe "-" (unwords . takeWhile (/="--")) $ M.lookup fun depmap

-- sepFields = concat . intersperse "\t"
sepFields fs = "| " ++ concat (intersperse " | " fs) ++ " |"