diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-04 18:06:12 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-04 18:06:12 +0200 |
commit | 048779ac250b0cb463839edd8f46d9785fb3f9e5 (patch) | |
tree | 41652db05632b058c59b8f74b67daa4d317c53a4 | |
parent | c1fe5811daf9780bc4a822776c3eb5c920941d45 (diff) | |
download | 2017-01-16_17:13:37-048779ac250b0cb463839edd8f46d9785fb3f9e5.tar 2017-01-16_17:13:37-048779ac250b0cb463839edd8f46d9785fb3f9e5.tar.gz 2017-01-16_17:13:37-048779ac250b0cb463839edd8f46d9785fb3f9e5.tar.bz2 2017-01-16_17:13:37-048779ac250b0cb463839edd8f46d9785fb3f9e5.tar.xz 2017-01-16_17:13:37-048779ac250b0cb463839edd8f46d9785fb3f9e5.zip |
quotients of random events
-rw-r--r-- | src/Sequence/Formula.hs | 9 |
1 files changed, 5 insertions, 4 deletions
diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs index fc61efb..66672a2 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, Formula | 4 | ( FormulaM, Formula, quot' |
5 | , evalFormula | 5 | , evalFormula |
6 | , val | 6 | , val |
7 | , d, z | 7 | , d, z |
@@ -9,9 +9,8 @@ module Sequence.Formula | |||
9 | 9 | ||
10 | import Control.Lens | 10 | import Control.Lens |
11 | import Data.Data.Lens | 11 | import Data.Data.Lens |
12 | import Data.Data (Data) | ||
13 | import Data.Typeable (Typeable) | ||
14 | 12 | ||
13 | import Control.Monad | ||
15 | import Control.Monad.Except | 14 | import Control.Monad.Except |
16 | import Control.Monad.Reader | 15 | import Control.Monad.Reader |
17 | import Numeric.Probability.Game.Event | 16 | import Numeric.Probability.Game.Event |
@@ -28,7 +27,7 @@ import Data.Maybe | |||
28 | 27 | ||
29 | type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a | 28 | type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a |
30 | 29 | ||
31 | type Formula input = Formulam input Int | 30 | type Formula input = FormulaM input Int |
32 | 31 | ||
33 | data Question input = Question | 32 | data Question input = Question |
34 | { answer :: Traversal' input (Formula input) | 33 | { answer :: Traversal' input (Formula input) |
@@ -46,6 +45,8 @@ instance Integral a => Num (FormulaM input a) where | |||
46 | sum <$> replicateM (fromIntegral n) y | 45 | sum <$> replicateM (fromIntegral n) y |
47 | fromInteger = return . fromInteger | 46 | fromInteger = return . fromInteger |
48 | 47 | ||
48 | quot' :: Integral a => FormulaM input a -> FormulaM input a -> FormulaM input a | ||
49 | quot' = liftM2 quot | ||
49 | 50 | ||
50 | askQuestion :: MonadIO m => input -> (Question input) -> m input | 51 | askQuestion :: MonadIO m => input -> (Question input) -> m input |
51 | askQuestion input q@(Question{..}) = flip (set answer) input . maybe (throwError q) return <$> askQ prompt (join . fmap readMaybe) | 52 | askQuestion input q@(Question{..}) = flip (set answer) input . maybe (throwError q) return <$> askQ prompt (join . fmap readMaybe) |