Base.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveFunctor #-}

-- | Datatypes which encode errors.
module Descript.Misc.Error.Result.Base
  ( ErrorMsg (..)
  , Result (..)
  , UResult
  , strToMsg
  , msgToStr
  , maybeToResult
  , maybeToUResult
  , eitherToResult
  , isFailure
  , isSuccess
  , mapSuccess
  , mapError
  ) where

import Descript.Misc.Summary
import Data.Monoid
import Data.Bifunctor
import Data.List
import Control.Applicative
import Control.Monad

-- | An error message. Like an enhanced string - when combined,
-- automatically adds "and".
newtype ErrorMsg = ErrorMsg [String] deriving (Eq, Ord, Read, Show, Monoid)

-- | Either produces a value or fails. This is isomorphic to 'Either',
-- but has an 'Alternative' and 'MonadPlus' implementation (for 'Monoid'
-- errors), and constructors are more descriptive ('Failure' and
-- 'Success' vs. 'Left' and 'Right').
data Result e a
  = Failure e
  | Success a
  deriving (Eq, Ord, Read, Show, Functor)

-- | Doesn't have any failure info.
type UResult a = Result () a

instance Bifunctor Result where
  bimap fe _ (Failure e) = Failure $ fe e
  bimap _ fx (Success x) = Success $ fx x

instance Applicative (Result e) where
  pure = Success
  Failure err <*> _ = Failure err
  Success _ <*> Failure err = Failure err
  Success f <*> Success x = Success $ f x

instance Monad (Result e) where
  return = pure
  Failure err >>= _ = Failure err
  Success x >>= f = f x

instance (Monoid e) => Alternative (Result e) where
  empty = Failure mempty
  Failure ex <|> Failure ey = Failure $ ex <> ey
  Failure _ <|> Success x = Success x
  Success x <|> _ = Success x

instance (Monoid e) => MonadPlus (Result e) where
  mzero = Failure mempty
  Failure ex `mplus` Failure ey = Failure $ ex <> ey
  Failure _ `mplus` Success x = Success x
  Success x `mplus` _ = Success x

instance Summary ErrorMsg where
  summary = msgToStr

instance (Summary e, Summary a) => Summary (Result e a) where
  summaryRec subSummary (Failure err) = "Failure: " ++ subSummary err
  summaryRec subSummary (Success x) = subSummary x

-- | Converts a user-freindly error message from 'String' to 'ErrorMsg'.
strToMsg :: String -> ErrorMsg
strToMsg x = ErrorMsg [x]

-- | Converts a user-freindly error message from 'ErrorMsg' to 'String'.
msgToStr :: ErrorMsg -> String
msgToStr (ErrorMsg xs) = intercalate ", and " xs

-- | If 'Just', a success. If 'Nothing', a failure with the given error.
maybeToResult :: e -> Maybe a -> Result e a
maybeToResult err Nothing = Failure err
maybeToResult _ (Just val) = Success val

-- | If 'Just', a success. If 'Nothing', a failure.
maybeToUResult :: Maybe a -> UResult a
maybeToUResult = maybeToResult ()

-- | Converts an 'Either', where 'Left' encodes a failure reason and
-- 'Right' encodes a result, into a 'Result'.
eitherToResult :: Either e a -> Result e a
eitherToResult (Left err) = Failure err
eitherToResult (Right val) = Success val

-- | Is the result a failure?
isFailure :: Result e a -> Bool
isFailure (Failure _) = True
isFailure (Success _) = False

-- | Is the result a success?
isSuccess :: Result e a -> Bool
isSuccess (Failure _) = False
isSuccess (Success _) = True

-- | If the result is a success, transforms it's value.
mapSuccess :: (a -> b) -> Result e a -> Result e b
mapSuccess = fmap

-- | If the result is a failure, transforms it's error.
mapError :: (e1 -> e2) -> Result e1 a -> Result e2 a
mapError f (Failure err) = Failure $ f err
mapError _ (Success x) = Success x