{-
ToDo:
only read log file if present
translation from country code to country name
   including warning for unknown countries
-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Main where

import qualified Control.Monad.Trans.State as SM
import qualified Control.Monad.Trans.Reader as RM
import Control.Monad.Trans (MonadIO, liftIO, lift, )

import Data.Tuple.HT (swap, )
import Data.Char (isAlpha, toUpper, )
import Data.List (sort, )
import qualified Data.List.Key as Key

import Data.Time.LocalTime (timeToTimeOfDay, timeOfDayToTime, )
import Data.Time.Format (readTime, )
import System.Locale (defaultTimeLocale, )
import qualified Data.Time.Format as TimeFmt
import qualified Data.Time.Clock as Clock

import qualified Data.Map as Map
import Data.Map (Map)

import qualified System.IO.Strict as SIO
import qualified System.IO as IO


type Country = String
data Contestant =
   Contestant {
      contestantCountry :: Country,
      contestantNumber :: Int
   }
type Time = Clock.DiffTime

type Entries = Map Country (Int, Time)


newtype M a = M (SM.StateT Entries (RM.ReaderT IO.Handle IO) a)
   deriving (Functor, Monad, MonadIO)

gets :: (Entries -> a) -> M a
gets f =
   M (SM.gets f)

modify :: (Entries -> Entries) -> M ()
modify f =
   M (SM.modify f)


logFileName :: FilePath
logFileName = "toilet.log"


parseContestant :: String -> Either Country Contestant
parseContestant str =
   let (country, number) = span isAlpha str
   in  case reads number of
         [(n, "")] -> Right $ Contestant country n
         _ -> Left country

output :: String -> M ()
output str =
   liftIO $ putStrLn $ "       " ++ str

data Direction = Enter | Leave
   deriving (Eq, Show, Enum)

writeLog :: Contestant -> Time -> Direction -> M ()
writeLog cnt time dir =
   M (lift RM.ask >>= \h ->
      liftIO $
        (IO.hPutStrLn h $
         formatContestant cnt ++ " " ++
         formatDirection dir ++ " " ++
         formatTime time) >>
        IO.hFlush h)

logToEntries :: String -> Entries
logToEntries =
   foldl (\ent (Contestant country number, dirStr, time) ->
      case dirStr of
         Enter -> Map.insert country (number, time) ent
         Leave -> Map.delete country ent)
      Map.empty .
   parseLog

parseLog :: String -> [(Contestant, Direction, Time)]
parseLog =
   map (\[cntStr,dirStr,timeStr] ->
      (either
         (error $ "invalid contestant identifier " ++ cntStr)
         id $ parseContestant cntStr,
       case dirStr of
          "enters" -> Enter
          "leaves" -> Leave
          _ -> error $ "invalid direction " ++ dirStr,
       subtract timeZoneOffset $
       timeOfDayToTime $
       readTime defaultTimeLocale "%R" timeStr)) .
   map words .
   lines

timeZoneOffset :: Time
timeZoneOffset = 2*60*60

formatDirection :: Direction -> String
formatDirection dir =
   case dir of
      Enter -> "enters"
      Leave -> "leaves"

formatContestant :: Contestant -> String
formatContestant (Contestant country number) =
   country ++ show number

formatTime :: Time -> String
formatTime =
   TimeFmt.formatTime defaultTimeLocale "%R" . timeToTimeOfDay .
   (timeZoneOffset+)

blockedMsg :: Contestant -> Time -> M ()
blockedMsg cnt time =
   output $
      "toilet blocked by " ++ formatContestant cnt ++
      " since " ++ formatTime time

caseToilet ::
   Country ->
   (Int -> Time -> M a) ->
   (M a) ->
   M a
caseToilet country ifBlocked ifFree =
   maybe
      ifFree
      (\(number, time) -> ifBlocked number time)
     =<< gets (Map.lookup country)

listToilet :: M ()
listToilet =
   mapM_ (\(country, (number, time)) ->
      output $ country ++ show number ++ " since " ++ formatTime time) =<<
   gets Map.toAscList

{-
mapM_ (\(n,country) -> putStrLn $ show n ++ " " ++ country) . countryFrequencies =<< readFile "toilet-correct.log"
-}
countryFrequencies :: String -> [(Int, String)]
countryFrequencies =
   reverse . sort .
   map swap .
   Map.toList .
   Map.fromListWith (+) .
   map (\(cnt,_,_) -> (contestantCountry cnt, 1)) .
   filter (\(_,dir,_) -> dir == Enter) .
   parseLog


{-
mapM_ (\(n,country) -> putStrLn $ show n ++ " " ++ country) . countryTotalTimes =<< readFile "toilet-correct.log"
-}
countryTotalTimes :: String -> [(Int, String)]
countryTotalTimes =
   reverse . sort .
   map swap .
   Map.toList .
   Map.fromListWith (+) .
   map (\(cnt,dir,time) ->
      (contestantCountry cnt,
       round . (/ (60::Double)) . realToFrac $
       case dir of
          Enter -> -time
          Leave -> time)) .
   parseLog


countryMaximumTimes :: String -> [(Int, String)]
countryMaximumTimes =
   reverse . sort .
   map swap .
   Map.toList .
   snd .
   foldl
      (\(startTimes, maxTimes) (cnt,dir,time) ->
          case dir of
             Enter ->
                (Map.insertWith (error "entered twice") cnt time startTimes,
                 maxTimes)
             Leave ->
                (Map.delete cnt startTimes,
                 let duration = time - Map.findWithDefault (error "never entered") cnt startTimes
                 in  Map.insertWith max cnt duration maxTimes))
      (Map.empty, Map.empty) .
   map (\(cnt,dir,time) ->
      (contestantCountry cnt,
       dir,
       round . (/ (60::Double)) . realToFrac $ time)) .
   parseLog


{-
writeFile "toilet-by-country.log" . sortForCountry =<< readFile "toilet-correct.log"
-}
sortForCountry :: String -> String
sortForCountry =
   unlines .
   map unlines .
   Key.group (take 3) .
   Key.sort (take 3) .
   lines


{-
writeFile "toilet-by-contestant.log" . sortForContestant =<< readFile "toilet-correct.log"
-}
sortForContestant :: String -> String
sortForContestant =
   unlines .
   map unlines .
   Key.group (take 4) .
   Key.sort (take 4) .
   lines


loop :: M ()
loop =
   do ln <- fmap (map toUpper) $ liftIO getLine
      if ln=="LIST"
        then listToilet
        else
          case parseContestant ln of
             Left country ->
                caseToilet country
                   (blockedMsg . Contestant country)
                   (output "toilet free")
             Right cnt@(Contestant country number) ->
                fmap Clock.utctDayTime (liftIO Clock.getCurrentTime) >>= \time ->
                caseToilet country
                   (\oldNumber oldTime ->
                       let oldCnt = Contestant country oldNumber
                       in  if number==oldNumber
                             then
                                output (ln ++ " leaves toilet at " ++ formatTime time) >>
                                writeLog oldCnt time Leave >>
                                modify (Map.delete country)
                             else blockedMsg oldCnt oldTime)
                   (do writeLog cnt time Enter
                       modify (Map.insert country (number, time))
                       output (ln ++ " enters toilet at " ++ formatTime time))
      loop

main :: IO ()
main =
   let M lp = loop
   in  SIO.readFile logFileName >>= \logContent ->
       IO.withFile logFileName IO.AppendMode $ \h ->
       flip RM.runReaderT h $ flip SM.evalStateT
          (logToEntries logContent) lp