--module Main (main,matches) where
module HsBot.HsBot where

import IO
import System

-- Start configuration

version :: String
version = "0.0"

-- End configuration

data Karma = Karma { karmaName :: String, minPts :: Int, minPerc :: Float } deriving (Show, Read)

instance Eq Karma where x == y = (minPerc x) == (minPerc y) && (minPts x == minPts y)

instance Ord Karma where
	x > y	| (minPerc x) > (minPerc y) = True
		| otherwise = (minPts x) > (minPts y)
	x < y	| (minPerc x) < (minPerc y) = True
		| otherwise = (minPts x) < (minPts y)
	x >= y	= not (x < y)
	x <= y	= not (x > y)

data Conf = Conf { line :: String, loggs :: [String], maxLoggs :: Int, users :: [User], karmas :: [Karma] } deriving (Show, Read)

data User = User { userName :: String, userPts :: Int } deriving (Show, Read) 

instance Eq User where x == y = (userPts x) == (userPts y)

instance Ord User where
	x < y = (userPts x) < (userPts y)
	x > y = (userPts x) > (userPts y)
	x >= y = not (x < y)
	x <= y = not (x > y)

class Render a where render :: a -> String

instance Render User where
	render user = userName user ++ ": " ++ 
		(userKarma user) ++ 	" (rank " ++ 
		(show $ userRank user) ++ "/" ++ 
		(show numUsers) ++ "; " ++ 
		(show $ userPts user) ++ "pts; " ++ 
		(show $ userPerc user) ++ "%)"

loggMessage :: String -> Conf -> Conf
loggMessage message conf = let l = message : (loggs conf)
                               l' | (length l) > (maxLoggs conf) = init l
				  | otherwise = l
			    in conf { loggs = l' } 

printLoggs :: Conf -> IO ()
printLoggs conf = printLoggs' $ reverse (loggs conf)
	where printLoggs' [] = return ()
	      printLoggs' (l:logg) = do { putStrLn l; printLoggs' logg }
		 
numUsers :: Int
numUsers = length $ users makeConf

sortedUsers :: [User]
sortedUsers = sort $ users makeConf

userEquals :: User -> User -> Bool
userEquals x y = (userName x) == (userName y)

userRank :: User -> Int
userRank = userRank' 1 sortedUsers
	where userRank' rank (x:xs) user
		| userEquals x user = rank
		| otherwise = userRank' (rank+1) xs user

getUser :: String -> Conf -> User
getUser name = head . filter (\x -> userName x == name) . users

userPerc :: User -> Float
userPerc user = 
	let rank = userRank user
	    userPerc' 
		| rank == 1 = 100 -- 1st always has 100%
		| rank == numUsers = 0 -- back always has 0%
		| otherwise = let userWeight = 100 / (fromIntegral numUsers)
			       in 100 - userWeight * (fromIntegral rank)
	 in userPerc' 

userKarma :: User -> String 
userKarma user = userKarma' (userPts user) (userPerc user)
	where userKarma' pts perc = 
		let cands = sort $ filter (\x -> minPts x <= pts && minPerc x <= perc) (karmas makeConf)
		in karmaName $ cands !! 0 -- Best posible karma 

addUserKarma :: Int -> User -> User
addUserKarma add user = user { userPts = userPts user + add }

-- Sorts a list			 
sort :: (Ord a) => [a] -> [a]
sort [] = []
sort (x:xs) = sort (filter (>= x) xs) ++ [x] ++ sort (filter (< x) xs)

uniq :: (Eq a) => [a] -> [a]
uniq list = 
	let r = u' list 0                    
            u' [] _ = []              
  	    u' (x:list) n 
		| member x r n = u' list n 
		| otherwise = x:(u' list (n + 1))
  	    member e list 0 = False
  	    member y (x:list) n = x == y || member y list (n - 1)
        in r

split :: String -> Char -> [String]
split [] delim = [""]
split (c:cs) delim 
	| c == delim = "" : rest
   	| otherwise = (c : head rest) : tail rest
   where rest = split cs delim

-- Returns a list of all strings to increase or decrease the karma of
matches :: String -> String -> [String]
matches search string = uniq $ case m' $ occ search string of
		(list, "") -> list
		(list, rest) -> list ++ (matches search rest)
      where occ :: String -> String -> Maybe (String, String)
	    occ search str = o' "" search str
	    	where o' pred [] str = Just (init . init $ reverse pred, str)
	    	      o' pred occ [] = Nothing
	    	      o' pred (m:occ) (s:str) 
	    		| otherwise = o' (s:pred) search str
	    extr extrF = extrF . filter (\x -> (x /= '-') && (x /= '+')) 
	    extrL str -- extract left side
		| null str || last str == ' ' = []
		| otherwise = [last $ split str ' ']
      	    extrR str -- extract right side
		| null str || str !! 0 == ' ' = []
		| otherwise = [split str ' ' !! 0] 
	    m' (Just (a, b)) = ((extr extrL a) ++ (extr extrR b), b)
	    m' Nothing = ([], [])

processInput :: Conf -> Conf
processInput conf = addAll --loggMessage "foo" conf
	where add :: [User] -> [User]
	      add [] = []
	      add (u:[]) = addUserKarma 1 u : []
	      add (u:us) = addUserKarma 1 u : (add us)
	      addAll = conf { users = add (users conf)  }
	      plus = matches "++" (line conf)
	      minus = matches "--" (line conf)

help :: IO ()
help = do
	putStrLn "\t!h - Print help"
	putStrLn "\t!l - Print loggs"
	putStrLn "\t!p - Print current configuration"
	putStrLn "\t!q - Quit"

loop :: Conf -> IO ()
loop conf = do
	line <- getLine
	case line of
		"!h" -> do { help; loop conf }
		"!l" -> do { printLoggs conf; loop conf }
		"!p" -> do { putStrLn $ show conf; loop conf }
		"!q" -> do { putStrLn "Good bye"; exitWith ExitSuccess }
		_ -> do { putStrLn line; loop $ processInput $ conf { line = line } }

main :: IO ()	
main = do
	putStrLn $ "Welcome to " ++ version ++ " (Enter !h for help)"
	loop makeConf

makeTestConf :: Conf
makeTestConf = Conf {
	line = "",
	loggs = [],
	maxLoggs = 10,
	users = [
		User "thunder" 100,
		User "otto" 1,
		User "rantanplan" 3,
		User "rantanplan2" 3,
		User "icefox2" 11,
		User "icefox" 10,
		User "foobar" 5,
		User "foobar1" 5,
		User "foobar2" 5,
		User "foobar3" 5,
		User "foobar4" 5,
		User "foobar5" 5,
		User "foobar6" 5,
		User "openfire" 2
	],
	karmas = [
		Karma "God" 20 90,
		Karma "Guru" 10 80,
		Karma "Nerd" 10 70, 
		Karma "Expert" 5 60, 
		Karma "Geek" 3 40,
		Karma "Advanced" 0 20, 
		Karma "Cool dude" 0 0 
	] }

makeConf :: Conf
makeConf = makeTestConf