{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances, OverloadedStrings #-} module Sequence.Utils ( withArg, withFocus , toName, fromName , module Sequence.Utils.Ask ) 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 Sequence.Utils.Ask 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 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 _ = "" 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 _ = "" 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