import Data.List
import Network
import Network.Curl.Download
import Random
import System.Exit
import System.IO
import System.Process
import Text.HTML.TagSoup
import Text.HTML.TagSoup.Parser
import Text.Printf
import Time

server    = "irc.freenode.net"
port      = 6667
chan      = "#plugfr"
nick      = "plugfrbot"
logFile   = "plugfr.log"
quoteFile = "plugfr.quotes"
stuffFile = "plugfr.stuff"

main = withSocketsDo $ do
         h <- connectTo server (PortNumber (fromIntegral port))
         hSetBuffering h NoBuffering
         write h "NICK" nick
         write h "USER" (nick++" 0 * :plugfrbot plugfrbot")
         write h "JOIN" chan
         listen h
         

write :: Handle -> String -> String -> IO ()
write h s t = do
  hPrintf h "%s %s\r\n" s t
  printf    "> %s %s\n" s t

listen :: Handle -> IO ()
listen h = forever $ do
    t <- hGetLine h
    let s = init t
    putStrLn s
    if ping s then pong s else if ("372 " ++ nick) `isInfixOf` s || ("332 " ++ nick) `isInfixOf` s then return () else eval h (clean s) (getPseudonym s) (takeWhile (/= ' ') . dropWhile (/= ' ') . dropWhile (/= ' ') $ s) ; ircLog $ "<" ++ (getPseudonym s) ++ "> " ++ clean s
  where
    forever a = do a; forever a
    clean     = drop 1 . dropWhile (/= ':') . drop 1
    ping x    = "PING :" `isPrefixOf` x
    pong x    = write h "PONG" (':' : drop 6 x)

eval :: Handle -> String -> String -> String -> IO ()
eval h       "!site"            _   _   = privmsg h "http://www.plugfr.org/"
eval h       "!date"            _   _   = date h
eval h       "!quote"           _   _   = getRandomQuote h
eval h       "!whatdidimiss"    _   _   = getLatestStuff h 3
eval h x _ _ | "!wp " `isPrefixOf` x    = privmsg h ("http://fr.wikipedia.org/wiki/" ++ drop 4 x)
eval h x _ _ | "!wpen " `isPrefixOf` x = privmsg h ("http://en.wikipedia.org/wiki/" ++ drop 6 x)
eval h x _ _ | "!quote " `isPrefixOf` x   = getQuote h $ drop 7 x
eval h x _ _ | "!addquote " `isPrefixOf` x = addQuote h $ drop 10 x
eval h x _ _ | "!dice"   `isPrefixOf` x   = dice h
eval h x _ _ | "!highfive" `isPrefixOf` x = privmsg h "o/"
eval h x _ _ | "plugfrbot" `isInfixOf` x && "o/" `isInfixOf` x = privmsg h "\\o"
eval h x _ _ | "plugfrbot" `isInfixOf` x && "\\o" `isInfixOf` x = privmsg h "o/"

eval h x _ _ | "!important " `isPrefixOf` x = addStuff h $ drop 11 x
eval h x _ _ | "http://" `isInfixOf` x    = mapM_ (giveTitle h . ("http://"++)) $ getUrlsFromText x
eval h x pseudo prov | "!foo " `isPrefixOf` x = runFoo h (drop 5 x)
-- 
eval _ _ _ _                             = return ()

getUrlsFromText :: String -> [String]
getUrlsFromText s = aux 0 s "" []
                where
                aux 0 ('h':'t':'t':'p':':':'/':'/':xs) tmpstr res = aux 1 xs tmpstr res
                aux 0 (x:xs) tmpstr res = aux 0 xs tmpstr res
                aux 1 ('\n':xs) tmpstr res = aux 0 xs "" (tmpstr:res)
                aux 1 (' ':xs) tmpstr res = aux 0 xs "" (tmpstr:res)
                aux 1 (x:xs) tmpstr res = aux 1 xs (tmpstr++[x]) res
                aux 1 [] tmpstr res = if(tmpstr /= "") then (tmpstr:res) else res
                aux 0 [] tmpstr res = res

join :: Handle -> String -> IO ()
join h s = write h "JOIN" s

getPseudonym :: String -> String
getPseudonym = takeWhile (/='!') . drop 1

tell :: Handle -> String -> [String] -> IO ()
tell h pseudo content =
    sequence_ (map (\x -> write h "PRIVMSG" (pseudo ++ " :" ++ x)) content)

runFoo :: Handle -> String -> IO ()
runFoo h str = do
       let dest = takeWhile (/= ' ') str
       let rest = tail . dropWhile (/= ' ') $ str
       tell h dest [rest]

date :: Handle -> IO ()
date h = do
    t <- getClockTime
    privmsg h (calendarTimeToString . toUTCTime $ t)

ircLog :: String -> IO ()
ircLog s = do
    t <- getClockTime
    appendFile logFile $ (calendarTimeToString . toUTCTime $ t) ++ " " ++ s ++ "\n"

dice :: Handle -> IO ()
dice h = do
  ran <- getStdRandom (randomR(0,10)) :: IO Int
  privmsg h (show ran ++ " (over 10)")

privmsg :: Handle -> String -> IO ()
privmsg h s = do
          ircLog $ "<plugfrbot> " ++ s
          write h "PRIVMSG" $ chan ++ " :" ++ s
          putStrLn $ "I said : " ++ s

giveTitle :: Handle -> String -> IO ()
giveTitle h url = do
          content <- openURIString url
          handleTheRest content
          where
                titleFilter 0   ((TagOpen "title" _):xs) = titleFilter 1 xs
                titleFilter 1   ((TagText ti)       :xs) = ti
                titleFilter any (x:xs)                   = titleFilter any xs
                titleFilter _   _                        = ""
                
                cleaner (' ':' ':xs)                     = ' ':(cleaner xs)
                cleaner ('\n':xs)                        = ' ':(cleaner xs)
                cleaner (x:xs)                           = x:(cleaner xs)
                cleaner []                               = []
                
                handleTheRest (Left s)    = return ()
                handleTheRest (Right str) =
                              let s = filter (/= '\n') str in
                              let title = cleaner $ titleFilter 0 (parseTags s) in
                              if (length title > 0) then privmsg h $ "Title : " ++ filter (/= '\t') (take 100 title) ++ " (at " ++ (takeWhile (/= '/') (drop 7 url)) ++ ")" else putStrLn str

suck :: Handle -> IO String
suck h = catch (do
                c <- hGetChar h
                r <- suck h
                return $ c:r)
         (\err -> return [])
         
spawn :: String -> IO String
spawn cmd = do
    (inp, out, err, pid) <- runInteractiveProcess "/bin/sh" ["-c", cmd] Nothing Nothing
    log1 <- suck out
    log2 <- suck err
    hClose inp
    hClose out
    hClose err
    code <- waitForProcess pid
    return $ log1 ++ log2         

addQuote :: Handle -> String -> IO ()
addQuote h content = do
         appendFile quoteFile $ content ++ "\n"
         privmsg h "Quote added, bro."

getQuote :: Handle -> String -> IO ()
getQuote h filterString = do
         quotesContent <- readFile quoteFile
         let matchingQuotes = filter (filterString `isInfixOf`) $ lines quotesContent
         ran <- getStdRandom $ randomR (0, (length matchingQuotes) - 1) :: IO Int
         if (length matchingQuotes > 0) then privmsg h $ "Quote: `` " ++ (matchingQuotes !! (ran `mod` (length matchingQuotes))) ++ " ''" else return ()

getRandomQuote :: Handle -> IO ()
getRandomQuote h = do
         quotesContent <- readFile quoteFile
         let matchingQuotes = lines quotesContent
         ran <- getStdRandom $ randomR (0, (length matchingQuotes) - 1) :: IO Int
         privmsg h $ "Quote: `` " ++ (matchingQuotes !! ran) ++ " ''"


addStuff :: Handle -> String -> IO ()
addStuff h content = do
         appendFile stuffFile $ content ++ "\n"
         privmsg h "Note added"

getLatestStuff :: Handle -> Int -> IO ()
getLatestStuff h count = do
	stuffContent <- readFile stuffFile
	let lastStuff = take count $ reverse (lines stuffContent)
	privmsg h "Important stuffs"
	mapM_ (privmsg h . (" -"++)) lastStuff