blob: 7a6e689ea580499e28640acba9c58dfcbb5545a1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
{-# LANGUAGE RecordWildCards, RankNTypes, TypeSynonymInstances, FlexibleInstances #-}
module Sequence.Formula
( FormulaM
, evalFormula
, val
) where
import Control.Lens
import Control.Monad.Trans.Either
import Control.Monad.Reader
import Numeric.Probability.Game.Event
import Sequence.Utils
import Text.Read (readMaybe)
type FormulaM input a = ReaderT input (EitherT (Question input) EventM) a
data Question input = Question
{ answer :: Lens' input (Maybe Int)
, prompt :: String
}
instance Integral a => Num (FormulaM input a) where
(+) x y = (+) <$> x <*> y
(-) x y = (-) <$> x <*> y
negate = fmap negate
abs = fmap abs
signum = fmap signum
(*) x y = sum <$> (flip replicateM y =<< fromIntegral <$> x)
fromInteger = return . fromInteger
askQuestion :: MonadIO m => input -> (Question input) -> m input
askQuestion input q@(Question{..}) = flip (set answer) input <$> askQ prompt (join . fmap readMaybe)
evalFormula :: MonadIO m => input -> FormulaM input a -> m a
evalFormula input formula = do
result <- liftIO . enact . runEitherT . (runReaderT ?? input) $ formula
case result of
Left q -> askQuestion input q >>= flip evalFormula formula
Right result -> return result
val :: Integral a => Lens' input (Maybe Int) -> String -> FormulaM input Int
val answer prompt = view answer >>= maybe (lift . left $ Question{..}) return
|
