-- IRC art (spam)bot

import Data.Bits
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S.Char8
import qualified Data.ByteString.Internal as S.Internal
import Data.List
import Data.Word
import System.Directory
import System.Environment
import System.Exit
import System.IO
import Text.Printf

--import Debug.Trace

type BitMap = [Word8]
type MircString = String

type PpmBmp = [Word8]

type IrcChannel = String

data Image = Image {
  imgBmp :: BitMap,
  imgPitch :: Int,
  imgHeight :: Int
  }

ctrlC = [toEnum 03] :: String
ctrlO = [toEnum 15] :: String
ctrlV = [toEnum 22] :: String

-- https://www.mirc.com/colors.html
w24ToMirc :: BitMap -> MircString
w24ToMirc word
  -- White
  | (word!!0 > 210) && (word!!1 > 210) && (word!!2 > 210)
  = "0"
  -- Black
  | (word!!0 == 0) && (word!!1 == 0) && (word!!2 == 0)
  = "1"
  -- Light red
  | (word!!0 > 127) && (word!!1 == 0) && (word!!2 == 0)
  = "4"
  -- Light green
  | (word!!0 == 0) && (word!!1 > 147) && (word!!2 == 0)
  = "9"
  -- Light blue
  | (word!!0 == 0) && (word!!1 == 0) && (word!!2 > 127)
  = "12"
  -- Red (aka brown)
  | (word!!0 <= 127) && (word!!1 == 0) && (word!!2 == 0)
  = "5"
  -- Green
  | (word!!0 == 0) && (word!!1 <= 147) && (word!!2 == 0)
  = "3"
  -- Blue
  | (word!!0 == 0) && (word!!1 == 0) && (word!!2 <= 127)
  = "2"
  -- Yellow
  | (word!!0 > 252) && (word!!1 > 127) && (word!!2 == 0)
  = "8"
  -- Orange
  | (word!!0 <= 252) && (word!!1 <= 127) && (word!!2 == 0)
  = "7"
  -- Pink
  | (word!!0 > 156) && (word!!1 == 0) && (word!!2 > 156)
  = "13"
  -- Purple
  | (word!!0 <= 156) && (word!!1 == 0) && (word!!2 <= 156)
  = "6"
  -- Light cyan
  | (word!!0 == 0) && (word!!1 > 147) && (word!!2 > 147)
  = "11"
  -- Cyan
  | (word!!0 == 0) && (word!!1 <= 147) && (word!!2 <= 147)
  = "10"
  -- Light grey
  | (word!!0 > 127) && (word!!1 > 127) && (word!!2 > 127)
  = "15"
  -- Grey
  | otherwise = "14"

lineToMirc :: BitMap -> MircString
lineToMirc [] = []
lineToMirc line = ctrlC ++ w24ToMirc (take 3 line) ++ ctrlV ++ "  " ++ ctrlO
                  ++ lineToMirc (drop 3 line)

bmpToMirc :: Int -> Int -> BitMap -> MircString
bmpToMirc _ 0 _ = []
bmpToMirc pitch height bmp =lineToMirc (take pitch bmp) ++ "\n"
                             ++ bmpToMirc pitch (height-1) (drop pitch bmp)

w8Split :: Word8 -> [Word8] -> [[Word8]]
w8Split c = map S.unpack . S.split c . S.pack

w8ToString :: [Word8] -> String
w8ToString = S.Char8.unpack . S.pack

ppmToImage :: PpmBmp -> Image
ppmToImage ppm = Image
                 (intercalate [S.Internal.c2w '\n'] $ drop 3
                                (w8Split (S.Internal.c2w '\n') ppm))
                 ((read (w8ToString
                   ((w8Split (S.Internal.c2w ' ') ((w8Split
                                    (S.Internal.c2w '\n') ppm) !! 1)) !! 0)))*3)
                 (read ( w8ToString
                   ((w8Split (S.Internal.c2w ' ') ((w8Split
                                   (S.Internal.c2w '\n') ppm) !! 1)) !! 1)))

ircConnect :: String -> MircString
ircConnect credentials = printf "NICK miaowe\r\n\
             \USER nya 0 * :mew mew\r\n\
             \PRIVMSG NickServ :IDENTIFY %s\r\n" credentials

waitForMessage :: (String -> Bool) -> IO String
waitForMessage p = getLine >>= \l -> if p l
                                     then return l
                                     else
                                       (if (words l)!!0 == "PING"
                                       then
                                          putStr
                                          ("PONG " ++ ((words l)!!1) ++ "\r\n")
                                          >> hFlush stdout
                                       else return ())
                                       >> waitForMessage p

waitForCloak :: IO String
waitForCloak = waitForMessage (\l -> (words l)!!1 == "396")

waitForCommand :: IO String
waitForCommand = waitForMessage (\l -> if ((length (words l)) >= 4)
                                       then ((words l)!!3 == ":miaowe:")
                                       else False)

joinChannel :: String -> IO ()
joinChannel c = putStr (printf "JOIN %s\r\n" c)

sendToChannel :: IrcChannel -> MircString -> IO ()
sendToChannel c s = (putStr $ concat $ map (\l -> printf "PRIVMSG %s :%s\r\n" c l)
                    (lines s)) >> hFlush stdout

sendFile :: IrcChannel -> FilePath -> IO ()
sendFile channel path = S.readFile path
                        >>= sendToChannel channel .
                        (\img ->bmpToMirc
                                (imgPitch img)
                                (imgHeight img)
                                (imgBmp img)) .
                        ppmToImage .
                        S.unpack .
                        S.Char8.pack .
                        intercalate "\n" .
                        filter (\l->not (head l == '#')) .
                        lines .
                        S.Char8.unpack

trySendFile :: IrcChannel -> FilePath -> IO ()
trySendFile channel path = (doesFileExist (path)
                            >>= (\b ->
                                    if b
                                    then
                                      sendFile channel (path)
                                    else
                                      sendToChannel channel "No such file."
                                    >> hFlush stdout))

processCommand :: IrcChannel -> MircString -> IO ()
processCommand channel command | (words command)!!4 == "Quit" = exitSuccess
                               | otherwise = (if isInfixOf "/" ((words command)!!4)
                                              then
                                                sendToChannel channel
                                                "Only PWD please."
                                              else
                                                trySendFile channel
                                                ((words command)!!4))

mainLoop :: IrcChannel -> IO ()
mainLoop channel = waitForCommand
                   >>= \line ->
                         processCommand channel line
                         >> mainLoop channel
                        

main :: IO ()
main =
  openFile "conf" ReadMode
  >>= hGetLine
  >>= putStr . ircConnect
  >> hFlush stdout
  >> waitForCloak
  >> hFlush stdout
  >> getArgs
  >>= \args ->
        joinChannel (args!!0)
        >> hFlush stdout
        >> mainLoop (args!!0)