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 ../../examples/app/App.gf | grep \" -- \" >absfuns.tmp"
  funs <- readFile "absfuns.tmp" >>= return . lines
  deps <- readFile "../src/uddeps.labels" >>= return . lines
  let depmap = M.fromListWith (\x y -> x ++ [";"] ++ y) [(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 . addLink) rows
  putStrLnIf $ "GF RGL Functions"
  putStrLnIf $ "generated by lib/src/doc/AbsFunFoc.hs"
  putStrLnIf $ "%%date"
  putStrLnIf $ ""
  putStrLnIf $ "Functions in this table have links, e.g. http://www.grammaticalframework.org/lib/doc/absfuns.html#PredVP"
  putStrLn $ sepFields ["**Function**","**Type**","**Example**","**Dependencies**","**Module**"]
  putStrLn $ unlines entries


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

mkRow depmap ws = case ws of
  file:fun:":":typecomment -> named 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, italics (unwords (drop 2 rest))]  -- PredVP    : NP -> VP -> Cl ; -- John walks
   getDep fun = maybe "-" (unwords . takeWhile (/="--")) $ M.lookup fun depmap

-- for html (via txt2tags) generation
sepFields fs = "| " ++ concat (intersperse " | " fs) ++ " |"
named f = f ++ "''<a name=\"" ++ f ++ "\"></a>''"
italics e = "//" ++ map (\c -> case c of '[' -> '(' ; ']'->')'; _ -> c) e ++ "//"
putStrLnIf = putStrLn
addLink fs =
  let
    m = last fs
    abstract = case m of
      "App" -> "../../examples/app/"
      "Extensions" -> "translator/"
      _ -> "abstract/"
  in init fs ++ ["[" ++ m ++ " ../src/" ++ abstract ++ m ++ ".gf]"]

-- for tab separated generation
-- sepFields = concat . intersperse "\t"
-- named f = f
-- italics e = e
-- putStrLnIf = return ()
-- addLink fs = fs