diff options
Diffstat (limited to 'src/Sequence/Contact')
| -rw-r--r-- | src/Sequence/Contact/Archetypes.hs | 2 | ||||
| -rw-r--r-- | src/Sequence/Contact/Tests.hs | 14 |
2 files changed, 10 insertions, 6 deletions
diff --git a/src/Sequence/Contact/Archetypes.hs b/src/Sequence/Contact/Archetypes.hs index 3b014e4..8eb9dd7 100644 --- a/src/Sequence/Contact/Archetypes.hs +++ b/src/Sequence/Contact/Archetypes.hs | |||
| @@ -23,7 +23,7 @@ import qualified Data.CaseInsensitive as CI | |||
| 23 | 23 | ||
| 24 | instance Completion Entity GameState where | 24 | instance Completion Entity GameState where |
| 25 | completableLabel _ = "<archetype>" | 25 | completableLabel _ = "<archetype>" |
| 26 | complete _ _ (CI.foldCase -> prefix) = return . filter (prefix `isPrefixOf`) . map CI.foldedCase $ Map.keys archetypes | 26 | complete _ _ (CI.foldCase -> prefix) = return . map CI.original . filter ((prefix `isPrefixOf`) . CI.foldedCase) $ Map.keys archetypes |
| 27 | 27 | ||
| 28 | instance Argument Entity GameState where | 28 | instance Argument Entity GameState where |
| 29 | arg = return . fmap (flip (set eStats) def) . flip Map.lookup archetypes . CI.mk | 29 | arg = return . fmap (flip (set eStats) def) . flip Map.lookup archetypes . CI.mk |
diff --git a/src/Sequence/Contact/Tests.hs b/src/Sequence/Contact/Tests.hs index 86f72b5..8aa072a 100644 --- a/src/Sequence/Contact/Tests.hs +++ b/src/Sequence/Contact/Tests.hs | |||
| @@ -1,8 +1,8 @@ | |||
| 1 | {-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, ImpredicativeTypes #-} | 1 | {-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, ImpredicativeTypes #-} |
| 2 | 2 | ||
| 3 | module Sequence.Contact.Tests | 3 | module Sequence.Contact.Tests |
| 4 | ( TestResult(..) | 4 | ( TestResult(..), rWith, rBy |
| 5 | , Test | 5 | , Test, tCritSuccessMod, tCritFailureMod, tBaseDifficulty, tMod |
| 6 | , enactTest | 6 | , enactTest |
| 7 | ) where | 7 | ) where |
| 8 | 8 | ||
| @@ -55,12 +55,16 @@ instance Default Test where | |||
| 55 | } | 55 | } |
| 56 | 56 | ||
| 57 | tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test)) | 57 | tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test)) |
| 58 | tests = mconcat <$> sequence [ test "Stärke" (sAStrength . attributeTest) | 58 | tests = mconcat <$> sequence [ test "Stärke" $ sAStrength . attributeTest |
| 59 | |||
| 60 | , test "Archaische Distanzwaffen" $ sSArchaicRanged . skillTest | ||
| 61 | |||
| 62 | , test "Beißen" $ sSBiting . skillTest | ||
| 59 | ] | 63 | ] |
| 60 | where | 64 | where |
| 61 | test k v = maybe mempty (Map.singleton k) <$> preview v | 65 | test k v = maybe mempty (Map.singleton k) <$> preview v |
| 62 | 66 | ||
| 63 | -- skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x) | 67 | skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x) |
| 64 | attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x) | 68 | attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x) |
| 65 | 69 | ||
| 66 | 70 | ||
| @@ -71,7 +75,7 @@ getTest (CI.mk -> str) = folding tests' | |||
| 71 | 75 | ||
| 72 | instance Completion (FormulaM Stats Test) GameState where | 76 | instance Completion (FormulaM Stats Test) GameState where |
| 73 | completableLabel _ = "<test>" | 77 | completableLabel _ = "<test>" |
| 74 | complete _ st (CI.foldCase -> prefix) = return . fromMaybe [] . fmap (filter (prefix `isPrefixOf`) . map CI.foldedCase . Map.keys) $ previews (gFocus' . eStats) tests st | 78 | complete _ st (CI.foldCase -> prefix) = return . fromMaybe [] . fmap (map CI.original . filter ((prefix `isPrefixOf`) . CI.foldedCase) . Map.keys) $ previews (gFocus' . eStats) tests st |
| 75 | 79 | ||
| 76 | instance Argument (FormulaM Stats Test) GameState where | 80 | instance Argument (FormulaM Stats Test) GameState where |
| 77 | arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str)) | 81 | arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str)) |
