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

module Sequence.Utils
  ( withArg, withFocus
  , askQ, askBool
  , toName, fromName
  ) where

import Sequence.Types

import Control.Monad.State.Strict

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.Function
import Data.Default
import Data.Maybe
import Text.Read (readMaybe)

import Data.List

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

import System.Console.Readline (readline)


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 >>= \focus -> case focus of
  Nothing -> shellPutErrLn $ "Currently not focusing any entity"
  Just id -> f id

askBool :: String -> Bool -> Sh st Bool
askBool prompt initial = askQ prompt $ fromMaybe initial . join . fmap (eval . CI.mk)
  where
    eval "yes" = Just True
    eval "y" = Just True
    eval "no" = Just False
    eval "n" = Just False
    eval _ = Nothing

askQ :: String -> (Maybe String -> a) -> Sh st a
askQ prompt eval = eval <$> liftIO (readline $ prompt ++ " ")
  
unaligned = view faction' def
  
toName :: MonadState GameState m => EntityIdentifier -> m String
toName id = fromMaybe (show $ id ^. entityId) . fmap (CI.original . view entityName) . Bimap.lookup id <$> use gEntityNames

fromName :: MonadState GameState m => String -> m (Maybe EntityIdentifier)
fromName (readMaybe -> (Just (EntityIdentifier -> n))) = (n <$) . guard . Map.member n <$> use gEntities
fromName (EntityName . CI.mk -> name) = Bimap.lookupR name <$> 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 = fromName

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