diff options
Diffstat (limited to 'src/Sequence')
| -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 |
