diff options
Diffstat (limited to 'src/Sequence/Utils.hs')
-rw-r--r-- | src/Sequence/Utils.hs | 29 |
1 files changed, 29 insertions, 0 deletions
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 | ||