{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings #-}

module Sequence.Utils
  ( withArg, withFocus, withFocus'
  , toName
  , Argument(..)
  , Completion(..)
  , module Sequence.Utils.Ask
  ) where

import Sequence.Types

import Control.Monad.State.Strict
import Control.Monad.Trans.Maybe

import Control.Applicative
import Control.Monad
import Control.Lens

import Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap

import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI

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

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

import Data.Function
import Data.Default
import Data.Maybe
import Text.Read (readMaybe)

import Data.List
import Data.Bool
import Data.Char

import System.Console.Shell
import System.Console.Shell.ShellMonad
import System.Console.Shell.Backend.Haskeline

import Sequence.Utils.Ask
import Sequence.Contact.Types

class Argument a st | a -> st where
  arg :: String -> Sh st (Maybe a)

withArg :: Argument a st => (a -> Sh st ()) -> (Completable a -> Sh st ())
withArg f (Completable str) = arg str >>= \a -> case a of
  Nothing -> shellPutErrLn $ "Could not parse ‘" ++ str ++ "’"
  Just a  -> f a

withFocus :: (EntityIdentifier -> Sh GameState ()) -> Sh GameState ()
withFocus f = use gFocus >>= maybe (shellPutErrLn $ "Currently not focusing any entity") f

withFocus' :: (Entity -> Sh GameState a) -> Sh GameState (Maybe a)
withFocus' f = preuse gFocus' >>= maybe (Nothing <$ shellPutErrLn "Currently not focusing any entity") (fmap Just . f)

unaligned = view faction' def

toName :: MonadState GameState m => EntityIdentifier -> m String
toName ident = do
  let number = review entityId' ident
  isShadowed <- uses gEntityNames . Bimap.memberR $ view entityName number
  let number' = bool id ('#':) isShadowed $ number
  fromMaybe number' . fmap (review entityName) . Bimap.lookup ident <$> use gEntityNames

instance Completion EntityIdentifier GameState where
  completableLabel _ = "<entity>"
  complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . map ((evalState ?? st) . toName) . Map.keys $ st ^. gEntities

instance Argument EntityIdentifier GameState where
  arg = \str -> do
    fromForcedIdR <- fromForcedId str
    fromNameR <- fromName str
    fromIdR <- fromId str
    return $ fromForcedIdR <|> fromNameR <|> fromIdR
    where
      fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> use gEntityNames
      fromId (preview entityId' -> Just n) = (n <$) . guard . Map.member n <$> use gEntities
      fromId _ = return Nothing
      fromForcedId ('#':str) = fromId str
      fromForcedId _ = return Nothing

instance Completion Faction GameState where
  completableLabel _ = "<faction>"
  complete _ st prefix = return . filter ((isPrefixOf `on` CI.foldCase) prefix) . nub . sort $ unaligned : map (view faction') (st ^. inhabitedFactions)

instance Argument Faction GameState where
  arg = return . Just . flip (set faction') def

instance Completion (Set Hitzone) GameState where
  completableLabel _ = "<hitzones>"
  complete _ st (over each reverse . span (/= ',') . reverse -> (wPrefix, lPrefix))
    | not $ null wPrefix
    , all (== '*') wPrefix = return . pure . join $ hitzones
    | otherwise = return . map (lPrefix ++) . filter ((isPrefixOf `on` CI.foldCase) wPrefix) $ hitzones
    where
      hitzones = sort . map (review hitzone) $ fromMaybe [] (Map.keys <$> preview (gFocus' . eStats . sHitzones) st)
      join [] = ""
      join [x] = x
      join (x:xs) = x ++ "," ++ join xs

instance Argument (Set Hitzone) GameState where
  arg protoWs = runMaybeT $ do
    let
      trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
      split = foldr (\c l@(w:ws) -> if c == ',' then "" : l else (c : w) : ws) [""]
      ws = Set.fromList . map CI.mk . filter (not . null) . map trim . split $ protoWs
      hasGlob = Set.member "*" ws
    hitzones <- Set.map (view _Hitzone) . Map.keysSet <$> MaybeT (preuse $ gFocus' . eStats . sHitzones)
    guard (hasGlob || hitzones `Set.isSubsetOf` ws)
    return . Set.map (review _Hitzone) $ if hasGlob then hitzones else ws