diff options
-rw-r--r-- | src/Sequence/Contact/Types.hs | 6 | ||||
-rw-r--r-- | src/Sequence/Formula.hs | 10 |
2 files changed, 9 insertions, 7 deletions
diff --git a/src/Sequence/Contact/Types.hs b/src/Sequence/Contact/Types.hs index 815bd4e..b63b369 100644 --- a/src/Sequence/Contact/Types.hs +++ b/src/Sequence/Contact/Types.hs | |||
@@ -55,7 +55,7 @@ data Stats = Prop | |||
55 | , _sMaxVitality | 55 | , _sMaxVitality |
56 | , _sSeqVal | 56 | , _sSeqVal |
57 | , _sPainTolerance | 57 | , _sPainTolerance |
58 | , _sFatigueTolerance :: FormulaM Stats Int | 58 | , _sFatigueTolerance :: Formula Stats |
59 | } | 59 | } |
60 | | Quadruped | 60 | | Quadruped |
61 | { _sAStrength | 61 | { _sAStrength |
@@ -78,7 +78,7 @@ data Stats = Prop | |||
78 | , _sMaxVitality | 78 | , _sMaxVitality |
79 | , _sSeqVal | 79 | , _sSeqVal |
80 | , _sPainTolerance | 80 | , _sPainTolerance |
81 | , _sFatigueTolerance :: FormulaM Stats Int | 81 | , _sFatigueTolerance :: Formula Stats |
82 | } | 82 | } |
83 | | Dolphin | 83 | | Dolphin |
84 | { _sAStrength | 84 | { _sAStrength |
@@ -101,7 +101,7 @@ data Stats = Prop | |||
101 | , _sMaxVitality | 101 | , _sMaxVitality |
102 | , _sSeqVal | 102 | , _sSeqVal |
103 | , _sPainTolerance | 103 | , _sPainTolerance |
104 | , _sFatigueTolerance :: FormulaM Stats Int | 104 | , _sFatigueTolerance :: Formula Stats |
105 | } | 105 | } |
106 | makeLenses ''Stats | 106 | makeLenses ''Stats |
107 | 107 | ||
diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs index 2a4541f..fc61efb 100644 --- a/src/Sequence/Formula.hs +++ b/src/Sequence/Formula.hs | |||
@@ -1,7 +1,7 @@ | |||
1 | {-# LANGUAGE RecordWildCards, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, ViewPatterns, TypeFamilies #-} | 1 | {-# LANGUAGE RecordWildCards, RankNTypes, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, ViewPatterns, TypeFamilies #-} |
2 | 2 | ||
3 | module Sequence.Formula | 3 | module Sequence.Formula |
4 | ( FormulaM | 4 | ( FormulaM, Formula |
5 | , evalFormula | 5 | , evalFormula |
6 | , val | 6 | , val |
7 | , d, z | 7 | , d, z |
@@ -28,8 +28,10 @@ import Data.Maybe | |||
28 | 28 | ||
29 | type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a | 29 | type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a |
30 | 30 | ||
31 | type Formula input = Formulam input Int | ||
32 | |||
31 | data Question input = Question | 33 | data Question input = Question |
32 | { answer :: Traversal' input (FormulaM input Int) | 34 | { answer :: Traversal' input (Formula input) |
33 | , prompt :: String | 35 | , prompt :: String |
34 | , keepResult :: Bool | 36 | , keepResult :: Bool |
35 | } | 37 | } |
@@ -57,10 +59,10 @@ evalFormula = evalFormula' [] | |||
57 | Left q@(Question{..}) -> askQuestion input q >>= flip (evalFormula' $ bool (pure . set answer $ throwError q) mempty keepResult ++ finalChanges) formula | 59 | Left q@(Question{..}) -> askQuestion input q >>= flip (evalFormula' $ bool (pure . set answer $ throwError q) mempty keepResult ++ finalChanges) formula |
58 | Right result -> return (foldr ($) input finalChanges, result) | 60 | Right result -> return (foldr ($) input finalChanges, result) |
59 | 61 | ||
60 | val :: Integral a => Traversal' input (FormulaM input Int) -> String -> Bool -> FormulaM input Int | 62 | val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input |
61 | val answer prompt keepResult = preview answer >>= maybe (throwError Question{..}) id | 63 | val answer prompt keepResult = preview answer >>= maybe (throwError Question{..}) id |
62 | 64 | ||
63 | -- viewL :: Lens' lInput sInput -> Iso' (FormulaM sInput a) (FormulaM lInput a) | 65 | -- viewL :: Lens' lInput sInput -> Prism' (FormulaM sInput a) (FormulaM lInput a) |
64 | -- viewL lTrav = iso asL asS | 66 | -- viewL lTrav = iso asL asS |
65 | -- where | 67 | -- where |
66 | -- asL small = join $ lift . withExceptT (\Question{..} -> Question{ answer = lTrav . answer . viewL lTrav, .. }) . runReaderT small <$> view lTrav | 68 | -- asL small = join $ lift . withExceptT (\Question{..} -> Question{ answer = lTrav . answer . viewL lTrav, .. }) . runReaderT small <$> view lTrav |