{-# LANGUAGE ViewPatterns, FlexibleContexts, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-} module Sequence.Utils ( withArg, toName, fromName ) where import Sequence.Types import Control.Monad.State.Strict 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 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 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