module Keywords(keywords) where

import Util
import Text.HTML.TagSoup


keywords = do
    depends "temp/keyword/keyword.html" [] $ do
        createDirectoryIfMissing True "temp/keyword"
        system_ "wget http://haskell.org/haskellwiki/Keywords -O temp/keyword/keyword.html"

    src <- readFile "temp/keyword/keyword.html"
    let items = concatMap keywordFormat $ partitions (~== "<a name>") $
                takeWhile (~/= "<div class=printfooter>") $ parseTags src
    writeFile "result/keyword.txt" (unlines $ keywordPrefix ++ items)


keywordPrefix =
    ["-- Hoogle documentation, generated by Hoogle"
    ,"-- From http://www.haskell.org/haskellwiki/Keywords"
    ,"-- See Hoogle, http://www.haskell.org/hoogle/"
    ,""
    ,"-- | Haskell keywords, always available"
    ,"@package keyword"
    ,"@haddock http://haskell.org/haskellwiki/Keywords"
    ]


keywordFormat x = concat ["" : docs ++ ["@keyword " ++ n] | n <- name]
    where
        name = words $ f $ fromAttrib "name" (head x)
        docs = zipWith (++) ("-- | " : repeat "--   ") $
               concat $ intersperse [""] $
               map (docFormat . takeWhile (~/= "<div class=editsection>")) $
               partitions isBlock x

        isBlock (TagOpen x _) = x `elem` ["p","pre"]
        isBlock _ = False

        f ('.':'2':'C':'_':xs) = ' ' : f xs
        f ('.':a:b:xs) = chr res : f xs
            where [(res,"")] = readHex [a,b]
        f (x:xs) = x : f xs
        f [] = []


docFormat :: [Tag] -> [String]
docFormat (TagOpen "pre" _:xs) = ["<pre>"] ++ map (drop n) ys ++ ["</pre>"]
    where
        ys = lines $ innerText xs
        n = minimum $ map (length . takeWhile isSpace) ys

docFormat (TagOpen "p" _:xs) = g 0 [] $ words $ f xs
    where
        g n acc [] = [unwords $ reverse $ acc | acc /= []]
        g n acc (x:xs) | nx+1+n > 70 = g n acc [] ++ g nx [x] xs
                       | otherwise = g (n+nx+1) (x:acc) xs
            where nx = length x

        f (TagOpen "code" _:xs) = "<tt>" ++ innerText a ++ "</tt>" ++ f (drop 1 b)
            where (a,b) = break (~== "</code>") xs
        f (x:xs) = h x ++ f xs
        f [] = []

        h (TagText x) = unwords (lines x)
        h (TagOpen "a" xs) = ""
        h (TagClose "a") = ""
        h (TagClose "p") = ""
        h x = error $ "docFormat.f: " ++ show x