-- HsBot - The Karmabot By Paul Buetow

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

import IO
import System

-- Static configurations

version :: String
version = "0.0"

database :: String
database = "hsbot.db"

-- logfile :: String
-- logfile = "hsbot.log"

-- End of static configurations

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)

loop :: IO Conf -> IO ()
loop conf = 
   let loop' :: Conf -> IO ()
       loop' conf = do
          line <- readInput 
          getLambda line conf -- Executing the specific lambda function of 'commands'
       printHelp = putStr . foldr (++) "" . map (\(a,b,_) -> "\t" ++ a ++ " - " ++ b ++ "\n") 
       getLambda x = let (_, _, c) = getCommand x in c
       getDescr x = let (_, b, _) = getCommand x in b
       getCommand x = 
         let command = [ (a, b, c) | (a, b, c) <- commands, a == x ]
          in if length command == 0
               then getCommand "!h" -- If there is no such command print out the help
               else head command
         where commands = [      
          	("!h", "Prints help ", (\x -> do { printHelp commands; loop' x } ) ),
          	("!l", "Prints loggs", (\x -> do { printLoggs x; loop' x } ) ),
          	("!p", "Prints configuration", (\x -> do { putStrLn $ show x; loop' x } ) ),
          	("!s", "Saves configuration", (\x -> do { putStrLn "Saving current xiguration"; save x; loop' x } ) ),
          	("!q", "Quits", (\x -> do { putStrLn "Good bye"; save x; exitWith ExitSuccess } ) )]
       -- Extract the Conf from the IO Monad and run the loop
    in do conf' <- conf
          loop' conf'

-- Will be connected to IRC input in future instead of getLine
readInput :: IO String
readInput = getLine

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

save :: Conf -> IO ()
save = writeFile database . show

saveIO :: IO Conf -> IO ()
saveIO conf = do
   conf' <- conf
   writeFile database (show conf')

load :: IO Conf
load = do
   file <- readFile database
   return ( read file :: Conf )

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

makeIOConf :: IO Conf
makeIOConf = return (makeConf)