{-# LANGUAGE FlexibleContexts, ViewPatterns, OverloadedStrings, TupleSections #-}

import           Data.PQueue.Prio.Max (MaxPQueue)
import qualified Data.PQueue.Prio.Max as MaxPQueue

import           Data.Sequence (Seq, (|>), (<|), viewl, viewr, ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq

import Data.Text (Text)
import qualified Data.Text as Text

import Data.Set (Set)
import qualified Data.Set as Set

import Data.Default.Class
import Data.Maybe (fromMaybe, isNothing, fromJust)

import System.Environment.XDG.BaseDir (getUserCacheFile)
import System.Environment (getProgName)
import System.Exit

import System.Console.Haskeline

import Control.Monad.State.Strict
import Control.Monad.Writer.Strict
import Control.Monad.IO.Class
  
import Types
import Utils
import Command

main :: IO ()
main = do
  historyFile <- flip getUserCacheFile "history" =<< getProgName
  let
    settings = setComplete noCompletion {- TODO -} . (\x -> x { historyFile = Just historyFile }) $ defaultSettings
  void . flip runStateT def . runInputT settings $ runCli

-- data Cmd = PerformAlt Alteration (Maybe Comment)
--          | ShowTip
--          | ShowHistory (Maybe Integer)
--          | Dump

runCli :: (MonadIO m, MonadException m, SequenceM m) => InputT m () 
runCli = do
  input <- getInputLine "→ " 
  case input of
    Nothing -> liftIO exitSuccess
    Just input' -> do
      cmd <- parseCmd input'
      case cmd of
        UnknownCommand help    -> do
          outputStrLn $ help
        ParseError err         -> do
          outputStrLn $ "Error parsing input »" <> (fromMaybe "" input) <> "«: " <> err
        Empty                  -> return ()

        Quit                   -> liftIO exitSuccess

        Dump                   -> gets ctxSequence >>= mapM_ (outputStrLn . showAssoc) . MaxPQueue.toDescList
        ShowTip                -> do
          tip <- fmap snd <$> gets (MaxPQueue.getMax . ctxSequence)
          case tip of
            Just entity        -> outputStrLn . Text.unpack $ showEntity entity
            Nothing            -> outputStrLn "Queue is currently empty"
        ShowHistory ns         -> do
          let sel = maybe id takeR ns
          mapM_ (outputStrLn . show) =<< sel <$> gets ctxHistory
        PerformAlt alt comment -> apply alt comment
        _              -> undefined
  runCli

showAssoc :: (SequenceValue, Entity) -> String
showAssoc (val, entity) = show val <> "\t" <> (Text.unpack $ showEntity entity)


apply :: SequenceM m => Alteration -> Comment -> InputT m ()
apply alteration comment = alter alteration >> modify (\ctx -> ctx { ctxHistory = ctxHistory ctx |> (alteration, comment) })

alter :: SequenceM m => Alteration -> InputT m ()
alter (Modify entity ((+) -> mod)) = alterMatching entity mod
alter (Override entity (const -> mod)) = alterMatching entity mod
alter (Rename old new) = do
  [(k, _)] <- filter (\(_, v) -> v == old) <$> gets (MaxPQueue.assocsU . ctxSequence)
  alter (Drop old)
  alter (Insert new k)
alter (Drop entity) = do
  (matching, notMatching) <- MaxPQueue.partition (== entity) <$> gets ctxSequence
  modify $ \ctx -> ctx { ctxSequence = notMatching }
  when (MaxPQueue.null matching) warnEmpty
alter (Insert entity val) = do
  modify $ \ctx -> ctx { ctxSequence = MaxPQueue.insert val entity $ ctxSequence ctx }
  introduceNumbering entity


alterMatching :: SequenceM m => Entity -> (SequenceValue -> SequenceValue) -> InputT m ()
alterMatching entity mod = do
  (matching, notMatching) <- MaxPQueue.partition (== entity) <$> gets ctxSequence
  modify $ \ctx -> ctx { ctxSequence = notMatching `MaxPQueue.union` MaxPQueue.mapKeys mod matching }
  when (MaxPQueue.null matching) warnEmpty

introduceNumbering :: SequenceM m => Entity -> InputT m ()
introduceNumbering entity = do
  let
    matches (Entity name _) (Entity name' _) = name == name'
  (matching, notMatching) <- MaxPQueue.partition (matches entity) <$> gets ctxSequence
  if MaxPQueue.size matching <= 1
    then return ()
    else do
    let
      (matching', notMatching') = MaxPQueue.partition (\(Entity _ n) -> isNothing n) matching
      maxN = MaxPQueue.foldrU (\(Entity _ n) -> max n) (Just 0) notMatching'
    modify $ \ctx -> ctx { ctxSequence = snd $ MaxPQueue.foldrWithKey accum (fromJust maxN, MaxPQueue.union notMatching notMatching') matching' }
    if MaxPQueue.null notMatching'
      then outputStrLn $ "Had to introduce a numbering scheme to differentiate multiple entities called »" <> (Text.unpack $ showEntity entity) <> "«"
      else outputStrLn $ "Inserted new entity called »" <> (Text.unpack $ showEntity entity) <> "« into existing numbering scheme"
  where
    accum key (Entity val _) (n, queue) = (succ n, MaxPQueue.insert key (Entity val $ Just (succ n)) queue) 

warnEmpty :: MonadIO m => InputT m ()
warnEmpty = outputStrLn "Selection did not match any entities"