From f434263fcce697f29c668a1c9ac2f05a1de1012c Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 5 Jun 2016 02:11:43 +0200 Subject: more pretty --- src/Sequence/Contact/Archetypes.hs | 2 +- src/Sequence/Contact/Tests.hs | 14 +++++++++----- 2 files changed, 10 insertions(+), 6 deletions(-) (limited to 'src/Sequence') 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 instance Completion Entity GameState where completableLabel _ = "" - complete _ _ (CI.foldCase -> prefix) = return . filter (prefix `isPrefixOf`) . map CI.foldedCase $ Map.keys archetypes + complete _ _ (CI.foldCase -> prefix) = return . map CI.original . filter ((prefix `isPrefixOf`) . CI.foldedCase) $ Map.keys archetypes instance Argument Entity GameState where 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 @@ {-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances, ImpredicativeTypes #-} module Sequence.Contact.Tests - ( TestResult(..) - , Test + ( TestResult(..), rWith, rBy + , Test, tCritSuccessMod, tCritFailureMod, tBaseDifficulty, tMod , enactTest ) where @@ -55,12 +55,16 @@ instance Default Test where } tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test)) -tests = mconcat <$> sequence [ test "Stärke" (sAStrength . attributeTest) +tests = mconcat <$> sequence [ test "Stärke" $ sAStrength . attributeTest + + , test "Archaische Distanzwaffen" $ sSArchaicRanged . skillTest + + , test "Beißen" $ sSBiting . skillTest ] where test k v = maybe mempty (Map.singleton k) <$> preview v - -- skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x) + skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x) attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x) @@ -71,7 +75,7 @@ getTest (CI.mk -> str) = folding tests' instance Completion (FormulaM Stats Test) GameState where completableLabel _ = "" - complete _ st (CI.foldCase -> prefix) = return . fromMaybe [] . fmap (filter (prefix `isPrefixOf`) . map CI.foldedCase . Map.keys) $ previews (gFocus' . eStats) tests st + complete _ st (CI.foldCase -> prefix) = return . fromMaybe [] . fmap (map CI.original . filter ((prefix `isPrefixOf`) . CI.foldedCase) . Map.keys) $ previews (gFocus' . eStats) tests st instance Argument (FormulaM Stats Test) GameState where arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str)) -- cgit v1.2.3