module Main where

import System.Environment
import Text.HTML.TagSoup (Tag)
import Data.List.Split
import Data.List
import Parse.Thread
import FileUtils
import Parse.Post
import Data.Time.LocalTime
import Data.Time.Format
import Database.PostgreSQL.Simple

import Data.ByteString.Char8 (ByteString)
import Data.Maybe (isNothing)
import Text.Regex.Posix ((=~))

import Control.Concurrent.ParallelIO.Global
import Data.Pool

import Database.Insert
import Types

main :: IO ()
main = do
  args <- getArgs

  threadFiles <- getAllThreadFileNames (args !! 0)

  let psqlConnection = ConnectInfo {
    connectHost = "localhost"
  , connectPort = 5432
  , connectUser = "jleach"
  , connectPassword = "password"
  , connectDatabase = "sythe-mining"
  }

  connectionPool <- createPool (createConnection psqlConnection) close 1 60 8

  let threadGroupTasks = map (mapM (handleOneThreadPage connectionPool)) $ chunksOf (((length threadFiles) `div` 2) + 1) threadFiles

  parallel_ (threadGroupTasks) >> stopGlobalPool


  return ()

handlePostResource :: Pool Connection -> Thread -> [Tag ByteString] -> IO ()
handlePostResource pool thread html = do
  currentTimeZone <- getCurrentTimeZone
  let posts = getPostsFromHtml currentTimeZone thread html
  case posts of
    Left a -> print a
    Right xs -> do
      mapM (handleUserResource pool . user) xs
      mapM (withResource pool . insertPost) xs
      return ()

handleUserResource :: Pool Connection -> Maybe User -> IO ()
handleUserResource pool Nothing = return ()
handleUserResource pool (Just user) = do
  withResource pool (insertUser user)

handleThreadResource :: Pool Connection -> [Tag ByteString] -> IO (Maybe Thread)
handleThreadResource pool html = do
  let thread = getThreadFromHtml html
  case thread of
    Nothing -> do
      putStrLn "Failed to get thread from HTML. Skipping."
      return Nothing
    Just x -> do
      withResource pool (insertThread x)
      return thread

handleOneThreadPage :: Pool Connection -> String -> IO ()
handleOneThreadPage pool fileName = do
  html <- loadFile fileName
  case html of
    Nothing -> putStrLn $ "Failed to parse file: " ++ fileName
    Just xs -> do
      thread <- handleThreadResource pool xs
      case thread of
        Nothing -> putStrLn "Failed to get thread"
        Just x -> do
          handlePostResource pool x xs
      return ()
