1 files changed, 17 insertions, 4 deletions

diff --git a/src/Sequence/Formula.hs b/src/Sequence/Formula.hs
index 66672a2..c3e9e33 100644
--- a/src/Sequence/Formula.hs
+++ b/src/Sequence/Formula.hs
@@ -23,6 +23,9 @@ import Text.Read (readMaybe)
 import Data.Bool
 import Data.List
 import Data.Maybe
+import Data.Either
+
+import Debug.Trace
 
 
 type FormulaM input a = ReaderT input (ExceptT (Question input) EventM) a
@@ -35,6 +38,15 @@ data Question input = Question
                       , keepResult :: Bool
                       }
 
+instance Eq (Question a) where
+  (==) _ _ = True
+
+instance Ord (Question a) where
+  (<=) _ _ = True
+
+instance Show (Question a) where
+  show Question{..} = show prompt
+
 instance Integral a => Num (FormulaM input a) where
   (+) x y = (+) <$> x <*> y
   (-) x y = (-) <$> x <*> y
@@ -51,17 +63,18 @@ quot' = liftM2 quot
 askQuestion :: MonadIO m => input -> (Question input) -> m input
 askQuestion input q@(Question{..}) = flip (set answer) input . maybe (throwError q) return <$> askQ prompt (join . fmap readMaybe)
 
-evalFormula :: MonadIO m => input -> FormulaM input a -> m (input, a)
+evalFormula :: (MonadIO m, Ord a, Show a) => input -> FormulaM input a -> m (input, a)
 evalFormula = evalFormula' []
   where
-    evalFormula' finalChanges input formula = do
-      result <- liftIO . enact . runExceptT . (runReaderT ?? input) $ formula
+    evalFormula' finalChanges input formula = trace "evalFormula'" $ do
+      result <- liftIO . enact . traceShowId . runExceptT . (runReaderT ?? input) $ formula
+      liftIO . traceIO $ show (isLeft result, isRight result)
       case result of
         Left q@(Question{..}) -> askQuestion input q >>= flip (evalFormula' $ bool (pure . set answer $ throwError q) mempty keepResult ++ finalChanges) formula
         Right result -> return (foldr ($) input finalChanges, result)
 
 val :: Integral a => Traversal' input (Formula input) -> String -> Bool -> Formula input
-val answer prompt keepResult = preview answer >>= maybe (throwError Question{..}) id
+val answer prompt keepResult = preview answer >>= maybe (throwError Question{..}) id . trace "val"
 
 -- viewL :: Lens' lInput sInput -> Prism' (FormulaM sInput a) (FormulaM lInput a)
 -- viewL lTrav = iso asL asS