module Reporting.Result where

import qualified Control.Monad as M
import Control.Monad.Except (Except, runExcept)
import Data.Coapplicative
import qualified Reporting.Annotation as A


-- TASK

data Result warning error result =
    Result
      [A.Located warning]
      (RawResult [A.Located error] result)
    deriving (Show)


data RawResult e a
    = Ok a
    | Err e
    deriving (Show)


-- HELPERS

ok :: a -> Result w e a
ok value =
  Result [] (Ok value)


throw :: A.Region -> e -> Result w e a
throw region err =
  Result [] (Err [A.At region err])


throwMany :: [A.Located e] -> Result w e a
throwMany errors =
  Result [] (Err errors)


from :: (e -> e') -> Except [A.Located e] a -> Result w e' a
from f except =
  case runExcept except of
    Right answer ->
        ok answer

    Left errors ->
        throwMany (map (fmap f) errors)


mapError :: (e -> e') -> Result w e a -> Result w e' a
mapError f (Result warnings rawResult) =
  Result warnings $
    case rawResult of
      Ok v ->
          Ok v

      Err msgs ->
          Err (map (fmap f) msgs)


warn :: A.Region -> w -> Result w e ()
warn region warning =
  Result [A.At region warning] (Ok ())


addWarnings :: [A.Located w] -> Result w e a -> Result w e a
addWarnings newWarnings (Result warnings rawResult) =
  Result (newWarnings ++ warnings) rawResult


destruct :: (e -> b) -> (a -> b) -> RawResult e a -> b
destruct errFunc okFunc rawResult =
  case rawResult of
    Ok answer ->
        okFunc answer

    Err errors ->
        errFunc errors


toMaybe :: Result w x a -> Maybe a
toMaybe (Result _ (Ok a)) = Just a
toMaybe (Result _ (Err _)) = Nothing


toEither :: Result w x a -> Either [x] a
toEither (Result _ (Ok a)) = Right a
toEither (Result _ (Err x)) = Left $ fmap extract x


-- EXTRA FANCY HELPERS

instance M.Functor (Result w e) where
  fmap func (Result warnings rawResult) =
      case rawResult of
        Ok a ->
            Result warnings (Ok (func a))

        Err msgs ->
            Result warnings (Err msgs)


instance Applicative (Result w e) where
  pure value =
      ok value

  (<*>) (Result warnings resultFunc) (Result warnings' resultVal) =
      Result (warnings ++ warnings') $
          case (resultFunc, resultVal) of
            (Ok func, Ok val) ->
                Ok (func val)

            (Err msgs, Err msgs') ->
                Err (msgs ++ msgs')

            (Err msgs, _) ->
                Err msgs

            (_, Err msgs) ->
                Err msgs


instance M.Monad (Result w e) where
  return value =
      ok value

  (>>=) (Result warnings rawResult) callback =
      case rawResult of
          Err msg ->
              Result warnings (Err msg)

          Ok value ->
              let (Result warnings' rawResult') = callback value
              in
                  Result (warnings ++ warnings') rawResult'
