summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-06-04 18:06:12 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-06-04 18:06:12 +0200
commit048779ac250b0cb463839edd8f46d9785fb3f9e5 (patch)
tree41652db05632b058c59b8f74b67daa4d317c53a4 /src
parentc1fe5811daf9780bc4a822776c3eb5c920941d45 (diff)
download2017-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
Diffstat (limited to 'src')
-rw-r--r--src/Sequence/Formula.hs9
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
3module Sequence.Formula 3module 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
10import Control.Lens 10import Control.Lens
11import Data.Data.Lens 11import Data.Data.Lens
12import Data.Data (Data)
13import Data.Typeable (Typeable)
14 12
13import Control.Monad
15import Control.Monad.Except 14import Control.Monad.Except
16import Control.Monad.Reader 15import Control.Monad.Reader
17import Numeric.Probability.Game.Event 16import Numeric.Probability.Game.Event
@@ -28,7 +27,7 @@ import Data.Maybe
28 27
29type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a 28type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a
30 29
31type Formula input = Formulam input Int 30type Formula input = FormulaM input Int
32 31
33data Question input = Question 32data 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
48quot' :: Integral a => FormulaM input a -> FormulaM input a -> FormulaM input a
49quot' = liftM2 quot
49 50
50askQuestion :: MonadIO m => input -> (Question input) -> m input 51askQuestion :: MonadIO m => input -> (Question input) -> m input
51askQuestion input q@(Question{..}) = flip (set answer) input . maybe (throwError q) return <$> askQ prompt (join . fmap readMaybe) 52askQuestion input q@(Question{..}) = flip (set answer) input . maybe (throwError q) return <$> askQ prompt (join . fmap readMaybe)