diff options
Diffstat (limited to 'src/Sequence')
| -rw-r--r-- | src/Sequence/Contact/Types.hs | 2 | ||||
| -rw-r--r-- | src/Sequence/Utils.hs | 29 |
2 files changed, 31 insertions, 0 deletions
diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs index dff886d..47687b7 100644 --- a/src/Sequence/Contact/Types.hs +++ b/src/Sequence/Contact/Types.hs | |||
| @@ -36,6 +36,8 @@ hitzone = iso (Hitzone . CI.mk) (CI.original . _hitzone) | |||
| 36 | instance IsString Hitzone where | 36 | instance IsString Hitzone where |
| 37 | fromString = view hitzone | 37 | fromString = view hitzone |
| 38 | 38 | ||
| 39 | makePrisms ''Hitzone | ||
| 40 | |||
| 39 | makeLenses ''Armor | 41 | makeLenses ''Armor |
| 40 | 42 | ||
| 41 | instance Default Armor where | 43 | instance Default Armor where |
diff --git a/src/Sequence/Utils.hs b/src/Sequence/Utils.hs index 517c3c2..bbd1477 100644 --- a/src/Sequence/Utils.hs +++ b/src/Sequence/Utils.hs | |||
| @@ -11,6 +11,7 @@ module Sequence.Utils | |||
| 11 | import Sequence.Types | 11 | import Sequence.Types |
| 12 | 12 | ||
| 13 | import Control.Monad.State.Strict | 13 | import Control.Monad.State.Strict |
| 14 | import Control.Monad.Trans.Maybe | ||
| 14 | 15 | ||
| 15 | import Control.Applicative | 16 | import Control.Applicative |
| 16 | import Control.Monad | 17 | import Control.Monad |
| @@ -25,6 +26,9 @@ import qualified Data.CaseInsensitive as CI | |||
| 25 | import Data.Map.Strict (Map) | 26 | import Data.Map.Strict (Map) |
| 26 | import qualified Data.Map.Strict as Map | 27 | import qualified Data.Map.Strict as Map |
| 27 | 28 | ||
| 29 | import Data.Set (Set) | ||
| 30 | import qualified Data.Set as Set | ||
| 31 | |||
| 28 | import Data.Function | 32 | import Data.Function |
| 29 | import Data.Default | 33 | import Data.Default |
| 30 | import Data.Maybe | 34 | import Data.Maybe |
| @@ -32,12 +36,14 @@ import Text.Read (readMaybe) | |||
| 32 | 36 | ||
| 33 | import Data.List | 37 | import Data.List |
| 34 | import Data.Bool | 38 | import Data.Bool |
| 39 | import Data.Char | ||
| 35 | 40 | ||
| 36 | import System.Console.Shell | 41 | import System.Console.Shell |
| 37 | import System.Console.Shell.ShellMonad | 42 | import System.Console.Shell.ShellMonad |
| 38 | import System.Console.Shell.Backend.Haskeline | 43 | import System.Console.Shell.Backend.Haskeline |
| 39 | 44 | ||
| 40 | import Sequence.Utils.Ask | 45 | import Sequence.Utils.Ask |
| 46 | import Sequence.Contact.Types | ||
| 41 | 47 | ||
| 42 | class Argument a st | a -> st where | 48 | class Argument a st | a -> st where |
| 43 | arg :: String -> Sh st (Maybe a) | 49 | arg :: String -> Sh st (Maybe a) |
| @@ -85,3 +91,26 @@ instance Completion Faction GameState where | |||
| 85 | 91 | ||
| 86 | instance Argument Faction GameState where | 92 | instance Argument Faction GameState where |
| 87 | arg = return . Just . flip (set faction') def | 93 | arg = return . Just . flip (set faction') def |
| 94 | |||
| 95 | instance Completion (Set Hitzone) GameState where | ||
| 96 | completableLabel _ = "<hitzones>" | ||
| 97 | complete _ st (over each reverse . span (/= ',') . reverse -> (wPrefix, lPrefix)) | ||
| 98 | | not $ null wPrefix | ||
| 99 | , all (== '*') wPrefix = return . pure . join $ hitzones | ||
| 100 | | otherwise = return . map (lPrefix ++) . filter ((isPrefixOf `on` CI.foldCase) wPrefix) $ hitzones | ||
| 101 | where | ||
| 102 | hitzones = sort . map (review hitzone) $ fromMaybe [] (Map.keys <$> preview (gFocus' . eStats . sHitzones) st) | ||
| 103 | join [] = "" | ||
| 104 | join [x] = x | ||
| 105 | join (x:xs) = x ++ "," ++ join xs | ||
| 106 | |||
| 107 | instance Argument (Set Hitzone) GameState where | ||
| 108 | arg protoWs = runMaybeT $ do | ||
| 109 | let | ||
| 110 | trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace | ||
| 111 | split = foldr (\c l@(w:ws) -> if c == ',' then "" : l else (c : w) : ws) [""] | ||
| 112 | ws = Set.fromList . map CI.mk . filter (not . null) . map trim . split $ protoWs | ||
| 113 | hasGlob = Set.member "*" ws | ||
| 114 | hitzones <- Set.map (view _Hitzone) . Map.keysSet <$> MaybeT (preuse $ gFocus' . eStats . sHitzones) | ||
| 115 | guard (hasGlob || hitzones `Set.isSubsetOf` ws) | ||
| 116 | return . Set.map (review _Hitzone) $ if hasGlob then hitzones else ws | ||
