summaryrefslogtreecommitdiff
path: root/src/Sequence/Formula.hs
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-06-04 01:16:16 +0200
committerGregor Kleen <gkleen@yggdrasil.li>2016-06-04 01:16:16 +0200
commitc1fe5811daf9780bc4a822776c3eb5c920941d45 (patch)
treebe302fe9b3a26648b35d17b76b267730a7022fe8 /src/Sequence/Formula.hs
parentb6e4dcfd8b50f47f2ca781752b1b24c86cf8c962 (diff)
download2017-01-16_17:13:37-c1fe5811daf9780bc4a822776c3eb5c920941d45.tar
2017-01-16_17:13:37-c1fe5811daf9780bc4a822776c3eb5c920941d45.tar.gz
2017-01-16_17:13:37-c1fe5811daf9780bc4a822776c3eb5c920941d45.tar.bz2
2017-01-16_17:13:37-c1fe5811daf9780bc4a822776c3eb5c920941d45.tar.xz
2017-01-16_17:13:37-c1fe5811daf9780bc4a822776c3eb5c920941d45.zip
cleanup
Diffstat (limited to 'src/Sequence/Formula.hs')
-rw-r--r--src/Sequence/Formula.hs10
1 files changed, 6 insertions, 4 deletions
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
3module Sequence.Formula 3module 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
29type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a 29type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a
30 30
31type Formula input = Formulam input Int
32
31data Question input = Question 33data 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
60val :: Integral a => Traversal' input (FormulaM input Int) -> String -> Bool -> FormulaM input Int 62val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input
61val answer prompt keepResult = preview answer >>= maybe (throwError Question{..}) id 63val 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