{-# 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