#!/usr/bin/env stack
-- stack --resolver lts-8.0 script
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}

import Graphics.Rendering.Chart.Easy
import Graphics.Rendering.Chart.Backend.Cairo
import System.Environment
import Data.Colour (opaque)
import Data.Colour.SRGB (sRGB24read)
import GHC.Generics (Generic)
import qualified Data.HashTable.IO as H 
import qualified Data.Csv as C
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as B
import Control.Monad (forM_, when)
import Data.Hashable
import Data.List (sortBy)

type HashTable k v = H.BasicHashTable k v

data Girl = Blake
          | Cinder
          | Deerie
          | Emerald
          | Ilia
          | Neo
          | Nora
          | Penny
          | Pyrrha
          | Ruby
          | Shadowperson
          | Weiss
          | Winter
          | Yang deriving (Show, Read, Eq, Enum, Ord, Generic)

instance Hashable Girl

data Other = Geist
           | Ironwood
           | Jaune
           | Mercury
           | Nonanswer
           | Nuckelavee
           | Other
           | Port
           | Qrow
           | Ren
           | Roman
           | Shopkeep
           | Tyrian
           | Zwei 
           | Bad deriving (Show, Read, Eq, Enum, Ord, Generic)

instance Hashable Other

data Character = IsGirl Girl
               | NotGirl Other deriving (Show, Read, Eq, Generic, Ord)

simpleShow :: Character -> String
simpleShow (IsGirl g)  = show g
simpleShow (NotGirl o) = show o

isGirl :: Character -> Bool
isGirl (IsGirl  _) = True
isGirl _           = False

instance C.FromField Character where
    parseField s = case filter ((`B.isInfixOf` s) . B.pack . show) [Blake .. ] of
                     x:_ -> pure $ IsGirl x
                     []  -> case filter ((`B.isInfixOf` s) . B.pack . show) [Geist .. ] of
                              x:_ -> pure $ NotGirl x
                              []  -> mempty

instance C.ToField Character where
    toField = C.toField . simpleShow

instance Hashable Character

chartColors :: [AlphaColour Double]
chartColors = map (opaque . sRGB24read) 
                [ "#4f894a"
                , "#a540c5"
                , "#70d65d"
                , "#6158bb"
                , "#cbd352"
                , "#472b53"
                , "#d28b3b"
                , "#799fc2"
                , "#d54c3d"
                , "#85d4b7"
                , "#c5447e"
                , "#877e3b"
                , "#c88bc1"
                , "#3e4b3d"
                , "#d1b39a"
                , "#814238"
                , "#6a92be"
                , "#c8d63d"
                , "#8b4acb"
                , "#6ad258"
                , "#cd478f"
                , "#6dcdb5"
                , "#d54938"
                , "#483068"
                , "#bed184"
                , "#ba85c5"
                , "#cd993b"
                , "#424439"
                , "#c6b4af"
                , "#762e39"
                , "#577a3b"
                , "#b77253"
                , "#cdcf50"
                , "#653bba"
                , "#77d545"
                , "#cb4dc5"
                , "#7ad78c"
                , "#bc4577"
                , "#59803e"
                , "#726cbe"
                , "#c38339"
                , "#48284a"
                , "#7dcbbe"
                , "#c34839"
                , "#6c93b4"
                , "#524732"
                , "#ca94b7"
                , "#ccb491"
                , "#af7958"
                , "#673ebd"
                , "#c8d845"
                , "#cb4dc4"
                , "#66cc5b"
                , "#c55384"
                , "#71cdb1"
                , "#cf4a3a"
                , "#6495b3"
                , "#d3973a"
                , "#9080cf"
                , "#abb86d"
                , "#48315d"
                , "#ceb7bc"
                , "#612f2c"
                , "#445c38"
                ]

barFrom ::  String -> String -> FileOptions -> Int -> Int
         -> [(Character, Int)] -> IO ()
barFrom baseName title fo upper lower rawDat =
    toFile fo (baseName ++ "-bar-" ++ (show lower) ++ "-" ++ (show upper) ++ ".png") $ do
      let titleSuffix = if lower == 0 then "Top " ++ show upper else show (lower+1) ++ " to " ++ show upper
          dat = drop lower $ take upper rawDat
          toBar (k, v) (ks, vs) = ((simpleShow k):ks, v:vs)
          (titles, barData) = foldr toBar ([], []) dat :: ([String], [Int])
          indexAndOffset = map (\(n, l) -> (n, replicate n 0 ++ l)) . zip [0..] . map (:[])
          mkstyle c = (solidFillStyle c, Nothing)
          bPlot = do
            (b :: PlotBars Int Int) <- (bars [] (indexAndOffset barData))
            pure $ b  & plot_bars_style .~ BarsStacked
                        & plot_bars_spacing .~ BarsFixGap 5 5
                        & plot_bars_item_styles .~ map mkstyle (cycle $ drop lower $ take upper chartColors)

      layout_title .= title ++ titleSuffix
      layout_x_axis . laxis_generate .= autoIndexAxis titles
      layout_x_axis . laxis_override .= (\x -> x & axis_labels .~ [zip [0..] titles])
      plot $ plotBars <$> bPlot

main :: IO ()
main = do
    rawDat  <- getData
    outFile <- head <$> tail <$> getArgs

    case rawDat of
      (Left s)             -> print s
      (Right (inc, girls)) -> do
        let bigDef = def & fo_size   .~ (1280, 720)
                         & fo_format .~ PNG
            titleInc  = "r/RWBY Moderator Application Best Girl Responses (Inclusive) "
            titleGirl = "r/RWBY Moderator Application Best Girl Responses (Only actual girls from RWBY) "
            sortFst   = sortBy (\l r -> compare (fst l) (fst r))
            merge [] [] acc = acc
            merge ((k1, v1):as) [] acc = merge as [] $ (k1, v1, 0):acc
            merge [] ((k2, v2):bs) acc = merge [] bs $ (k2, 0, v2):acc
            merge a@((k1, v1):as) b@((k2, v2):bs) acc =
              case compare k1 k2 of
                EQ -> merge as bs $ (k1, v1, v2):acc
                LT -> merge as b  $ (k1, v1,  0):acc
                GT -> merge a  bs $ (k2,  0, v2):acc

        BL.writeFile (outFile ++ "-dump.csv") $ C.encode $ merge (sortFst inc) (sortFst girls) []

        barFrom outFile titleGirl bigDef 14 0 girls
        barFrom outFile titleInc bigDef 15 0 inc
        barFrom outFile titleInc bigDef 29 15 inc

getData :: IO (Either String ([(Character, Int)], [(Character, Int)]))
getData = do
    csvName   <- head <$> getArgs
    csv       <- BL.readFile csvName
    inclusive <- H.new :: IO (HashTable Character Int)
    girls     <- H.new :: IO (HashTable Character Int)
    let dat        = C.decode C.NoHeader csv
        update h v = do
                       check <- H.lookup h v
                       case check of
                         (Just n) -> H.insert h v (n + 1)
                         Nothing  -> H.insert h v 1
    case dat of
      (Left s)  -> pure $ Left s
      (Right d) -> do
        forM_ d $ \(inc, exc) -> do
          update inclusive inc
          when (isGirl exc) (update girls exc)
        let sortSnd = sortBy (\l r -> compare (snd r) (snd l))
        lhs <- fmap sortSnd $ H.toList inclusive
        rhs <- fmap sortSnd $ H.toList girls
        pure $ Right (lhs, rhs)