import Data.Binary (encode)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.Char (isSpace)
import Data.List
import Database.HDBC
import Database.HDBC.Sqlite3
import Text.ParserCombinators.Parsec (parse)

import Binary
import Parse (WikiText(..))

type Page = (String, [WikiText])

parseRedirect :: [WikiText] -> Maybe String
parseRedirect (Text "#redirect " : Link title target : xs) = Just target
parseRedirect (Text "#REDIRECT " : Link title target : xs) = Just target
parseRedirect _ = Nothing

replace _ _ [] = []
replace a b (x:xs) = (if x == a then b else x) : replace a b xs

categories :: [WikiText] -> [String]
categories [] = []
categories (Link title target : xs)
    | "Category:" `isPrefixOf` target =
        (replace '_' ' ' $ dropWhile isSpace $ drop 9 target) : categories xs
    | otherwise = categories xs
categories (_:xs) = categories xs

reset conn = do
    run conn "DROP TABLE IF EXISTS page" []
    run conn "CREATE TABLE page (title, text)" []
    run conn "DROP TABLE IF EXISTS alias" []
    run conn "CREATE TABLE alias (title, alias)" []
    run conn "DROP TABLE IF EXISTS category" []
    run conn "CREATE TABLE category (title, category)" []

main = do
    contents <- getContents
    let pages = read contents :: [Page]
    conn <- connectSqlite3 "cookbook.db"
    reset conn
    mapM_ (uncurry $ insert conn) pages
    commit conn
    where insert conn title [] = return 0
          insert conn title text =
              case parseRedirect text of
                   Just alias -> run conn "INSERT INTO alias VALUES (?, ?)"
                                     [SqlString title, SqlString alias]
                   Nothing -> do
                       mapM_ (\s -> run conn
                           "INSERT INTO category VALUES (?, ?)"
                           [SqlString title, SqlString s]) $ categories text
                       run conn "INSERT INTO page (title, text) VALUES (?, ?)"
                           [SqlString title, SqlByteString . S.concat .
                               L.toChunks . encode $ text]