-- | Computing folds in the @ErrorPath@ monad will yield the path of the error, in case of error.
module ErrorPath (
    ErrorPath, Path, oops, atom, level, runErrorPath
  ) where

import Control.Applicative
import Control.Monad

-- | A path in a tree is a list of indices of children to follow.
type Path = [Int]

-- | The @ErrorPath@ monad.
data ErrorPath e a = ErrorPath Int (Either (e, Path) a)

instance (Show a, Show e) => Show (ErrorPath e a) where
  show (ErrorPath pos eith) = "ErrorPath " ++ show pos ++ " (" ++ show eith ++ ")"

errorPathReturn :: a -> ErrorPath e a
errorPathReturn v = ErrorPath 0 (Right v)

errorPathBind :: ErrorPath e a -> (a -> ErrorPath e b) -> ErrorPath e b
errorPathBind (ErrorPath pos res) f =
  case res of
    Left errPath -> ErrorPath pos (Left errPath)
    Right v -> case f v of
      ErrorPath pos' res' -> ErrorPath (pos' + pos) res'

instance Monad (ErrorPath e) where
  return  = errorPathReturn
  (>>=)   = errorPathBind

instance Applicative (ErrorPath e) where
  pure  = return
  (<*>) = ap

instance Functor (ErrorPath e) where
  fmap = liftM

incPos :: ErrorPath e a -> ErrorPath e a
incPos ep@(ErrorPath pos res) = case res of
  Left _  -> ep
  Right _ -> ErrorPath (pos + 1) res

incLevel :: ErrorPath e a -> ErrorPath e a
incLevel (ErrorPath pos res) = ErrorPath 0 $ case res of
  Left (err, path)  -> Left (err, pos : path)
  Right v           -> Right v

eval :: Either e a -> ErrorPath e a
eval = either oops return

-- | Throw an error.
oops :: e -> ErrorPath e a
oops err = ErrorPath 0 (Left (err, []))

-- | Runs the computation, returning either failure with path or success.
runErrorPath :: ErrorPath e a -> Either (e, Path) a
runErrorPath (ErrorPath _ res) = res

-- | Runs a child computation, increasing the current position.
level :: ErrorPath e (Either e a) -> ErrorPath e a
level = incPos . incLevel . (>>= eval)

-- | Used on leaves.
atom :: Either e a -> ErrorPath e a
atom = incPos . eval