{- |
Module      : HaskBF.Eval
Description : Evaluate a BrainFuck program
Copyright   : (c) Sebastian Galkin, 2014
License     : MIT
Maintainer  : paraseba@gmail.com
Stability   : experimental

This module exports functions that allow to evaluate a BrainFuck program.
Evaluation supports two types of error, parsing and execution, by returning
instances of 'EvalResult'

This module should be all library users need to import.
-}

module HaskBF.Eval (
    eval, evalBS, evalStr
  , EvalResult (..)
  , Machine (..)
  , defaultIOMachine
  , simulatorMachine, SimState (SimState), simStateOutput
  , emptyState

  , module HaskBF.Tape
  , module HaskBF.Parser
) where

import Data.Int
  ( Int8 )

import Control.Monad
  ( liftM, when )

import Control.Monad.State
  ( State, modify, state, StateT ( StateT ), execStateT, get)

import Control.Monad.Error
  ( ErrorT ( ErrorT ), runErrorT )

import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Lazy.Char8 as BSC

import qualified HaskBF.Parser as P

import HaskBF.Parser
  ( ParseError )

import HaskBF.Tape
  ( Tape ( Tape ), blankTape, BFTape, BFExError, errMsg
  , errTape, rTape, wTape, left, right, inc, dec)

type ExecutionState m = StateT BFTape (ErrorT BFExError m)

{- | Underlying input output for the evaluation machine. Changing the monad 'm'
 - achives different results. For instance using the 'IO' monad an evaluator can
 - be created that does input/output to stdin/stdout. If the monad is 'State',
 - for instance, input/output can happen in memory.
 -
 - We offer two implementations of 'Machine':
 -
 -   * 'defaultIOMachine': under the 'IO' monad, does input/output using the
 -   standard streams
 -   * 'simulatorMachine': under the 'State' monad, does input/output on lists
 -
 - It's easy to create other 'Machine's by using different monads and
 - functions. -}
data Machine m =
  Machine { putByte :: Int8 -> m () -- ^ Write a byte to the output, under
                                    -- monad 'm'
          , getByte :: m Int8       -- ^ Get a byte under the 'm' monad
          }

evalTape :: Monad m
         => Machine m
         -> P.Program
         -> ExecutionState m ()
evalTape m = mapM_ (evalOp m)


{- | Evaluate a parsed BrainFuck program using I/O provided by the given
 - 'Machine'
 -
 - The result is either an execution error or the 'BFTape' representing the
 - resulting state of the tape after the last instruction was executed. -}
eval :: Monad m
     => Machine m                    -- ^ The machine used to do I/O
     -> P.Program                    -- ^ The program to evaluate
     -> m (Either BFExError BFTape)  -- ^ Resulting tape after evaluation or
                                     -- execution error
eval m p = runErrorT $ execStateT (evalTape m p) blankTape

-- | Evaluation result of an unparsed BrainFuck program
data EvalResult = EvalSuccess BFTape
                  {- ^ Parsing and evaluation were successful. The resulting
                   - state of the tape after the last instruction
                   - was executed. -}

                | EvalExecError BFExError
                  {- ^ The program was parsed successfully but evaluation
                   - failed.
                   - The reason for failure is overflowing a limit of the tape.
                   - The state of the tape before the error is included -}

                | EvalParseError ParseError
                  {- ^ The program can not be parsed. Parsing error message is
                   - included -}

{- | Evaluate an unparsed BrainFuck program using I/O provided by the given
 - 'Machine'
 -
 - The result is returned as an 'EvalResult' -}
evalBS :: Monad m
       => Machine m     -- ^ The machine used to do I/O
       -> BS.ByteString -- ^ The code to evaluate
       -> m EvalResult  -- ^ Parsing/evaluation result
evalBS machine program =
  either parseError evaluate . P.parseProgram $ program
  where parseError = return . EvalParseError
        evaluate = liftM (either EvalExecError EvalSuccess) . eval machine

{- | Evaluate an unparsed BrainFuck program using I/O provided by the given
 - 'Machine'
 -
 - The result is returned as an 'EvalResult' -}
evalStr :: Monad m
        => Machine m    -- ^ The machine used to do I/O
        -> String       -- ^ The code to evaluate
        -> m EvalResult -- ^ Parsing/evaluation result
evalStr m = evalBS m . BSC.pack

evolve :: Monad m
          => (BFTape -> m (Either BFExError BFTape))
          -> ExecutionState m ()
evolve g = StateT $ ErrorT . (>>= return . liftM ((),)) . g

evalOp :: Monad m
       => Machine m
       -> P.Op
       -> ExecutionState m ()

evalOp _ P.IncP = evolve $ return . right
evalOp _ P.DecP = evolve $ return . left
evalOp _ P.Inc  = evolve $ return . Right . inc
evalOp _ P.Dec  = evolve $ return . Right . dec

evalOp ( Machine { putByte = putB } ) P.PutByte =
  evolve $ \ tape -> liftM ( const ( Right tape ) ) $ ( putB . rTape ) tape

evalOp ( Machine {getByte = getB } ) P.GetByte =
  evolve $ \ tape -> liftM ( Right . flip wTape tape ) getB

evalOp machine (P.Loop ops) = do
  tape <- get
  when (rTape tape /= 0) $
    evalTape machine ops >> evalOp machine (P.Loop ops)


{- | A 'Machine' that can evaluate code under the 'IO' monad by doing I/O
 - to stdin/stout.
 -
 - Bytes are read by comnverting them from the ASCII code -}
defaultIOMachine :: Machine IO
defaultIOMachine = Machine (putChar . toEnum . fromIntegral)
                           (fmap (fromIntegral . fromEnum) getChar)

{- | State used by 'simulatorMachine' to evaluate code under the 'State' monad
 -
 - It maintains input and output bytes inside lists -}
data SimState =
  SimState {input :: [Int8], -- ^ Input bytes to use when the program
                             -- does @ "," @
            output :: [Int8] -- ^ Store for the program outputs done with
                             -- @ "." @
           }

-- | Extract the output stream from a 'simulatorMachine' state
simStateOutput :: SimState -> [Int8]
simStateOutput = reverse . output

-- | Initial 'simulatorMachine' state
emptyState :: SimState
emptyState = SimState [] []

{- | A 'Machine' that can evaluate program doing in-memory I/O under the 'State'
 - monad. It stores state as 'SimState' -}
simulatorMachine :: Machine (State SimState)
simulatorMachine =
  Machine (modify . writeByte)
          (state readByte)
  where writeByte byte s@(SimState {output = o} ) = s {output = byte : o}
        readByte s@(SimState {input = (byte : rest)}) = (byte, s {input = rest})
        readByte _ = error "Not enough input available"