-- | A @Result@ is the result of a computation that may fail. This is a great
-- way to manage errors in Elm, but we when using this package in Haskell we
-- tend to rely on 'Task.Task' a lot too for error handling.
module Result
  ( -- * Type and Constructors
    Result (..),

    -- * Mapping
    map,
    map2,
    map3,
    map4,
    map5,

    -- * Chaining
    andThen,

    -- * Handling Errors
    withDefault,
    toMaybe,
    fromMaybe,
    mapError,
  )
where

import Basics
import qualified Internal.Shortcut as Shortcut
import Maybe (Maybe (..))
import Prelude (fmap)
import qualified Prelude

-- | A @Result@ is either @Ok@ meaning the computation succeeded, or it is an
-- @Err@ meaning that there was some failure.
data Result error value
  = Ok value
  | Err error
  deriving (Int -> Result error value -> ShowS
[Result error value] -> ShowS
Result error value -> String
(Int -> Result error value -> ShowS)
-> (Result error value -> String)
-> ([Result error value] -> ShowS)
-> Show (Result error value)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall error value.
(Show value, Show error) =>
Int -> Result error value -> ShowS
forall error value.
(Show value, Show error) =>
[Result error value] -> ShowS
forall error value.
(Show value, Show error) =>
Result error value -> String
showList :: [Result error value] -> ShowS
$cshowList :: forall error value.
(Show value, Show error) =>
[Result error value] -> ShowS
show :: Result error value -> String
$cshow :: forall error value.
(Show value, Show error) =>
Result error value -> String
showsPrec :: Int -> Result error value -> ShowS
$cshowsPrec :: forall error value.
(Show value, Show error) =>
Int -> Result error value -> ShowS
Prelude.Show, Result error value -> Result error value -> Bool
(Result error value -> Result error value -> Bool)
-> (Result error value -> Result error value -> Bool)
-> Eq (Result error value)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall error value.
(Eq value, Eq error) =>
Result error value -> Result error value -> Bool
/= :: Result error value -> Result error value -> Bool
$c/= :: forall error value.
(Eq value, Eq error) =>
Result error value -> Result error value -> Bool
== :: Result error value -> Result error value -> Bool
$c== :: forall error value.
(Eq value, Eq error) =>
Result error value -> Result error value -> Bool
Eq)

instance Prelude.Functor (Result error) where
  fmap :: (a -> b) -> Result error a -> Result error b
fmap a -> b
func Result error a
result =
    case Result error a
result of
      Ok a
value -> b -> Result error b
forall error value. value -> Result error value
Ok (a -> b
func a
value)
      Err error
error -> error -> Result error b
forall error value. error -> Result error value
Err error
error

instance Prelude.Applicative (Result error) where
  pure :: a -> Result error a
pure = a -> Result error a
forall error value. value -> Result error value
Ok

  <*> :: Result error (a -> b) -> Result error a -> Result error b
(<*>) Result error (a -> b)
r1 Result error a
r2 =
    case (Result error (a -> b)
r1, Result error a
r2) of
      (Ok a -> b
func, Ok a
a) -> b -> Result error b
forall error value. value -> Result error value
Ok (a -> b
func a
a)
      (Err error
error, Result error a
_) -> error -> Result error b
forall error value. error -> Result error value
Err error
error
      (Ok a -> b
_, Err error
error) -> error -> Result error b
forall error value. error -> Result error value
Err error
error

instance Prelude.Monad (Result error) where
  >>= :: Result error a -> (a -> Result error b) -> Result error b
(>>=) Result error a
result a -> Result error b
func =
    case Result error a
result of
      Ok a
value -> a -> Result error b
func a
value
      Err error
error -> error -> Result error b
forall error value. error -> Result error value
Err error
error

-- | If the result is @Ok@ return the value, but if the result is an @Err@ then
-- return a given default value. The following examples try to parse integers.
--
-- > Result.withDefault 0 (Ok 123)   == 123
-- > Result.withDefault 0 (Err "no") == 0
withDefault :: a -> Result b a -> a
withDefault :: a -> Result b a -> a
withDefault a
fallback Result b a
result =
  case Result b a
result of
    Ok a
value -> a
value
    Err b
_ -> a
fallback

-- | Apply a function to a result. If the result is @Ok@, it will be converted.
-- If the result is an @Err@, the same error value will propagate through.
--
-- > map sqrt (Ok 4.0)          == Ok 2.0
-- > map sqrt (Err "bad input") == Err "bad input"
map :: (a -> value) -> Result x a -> Result x value
map :: (a -> value) -> Result x a -> Result x value
map =
  (a -> value) -> Result x a -> Result x value
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
Shortcut.map

-- | Apply a function if both results are @Ok@. If not, the first @Err@ will
-- propagate through.
--
--    map2 max (Ok 42)   (Ok 13)   == Ok 42
--    map2 max (Err "x") (Ok 13)   == Err "x"
--    map2 max (Ok 42)   (Err "y") == Err "y"
--    map2 max (Err "x") (Err "y") == Err "x"
--
-- This can be useful if you have two computations that may fail, and you want
-- to put them together quickly.
map2 :: (a -> b -> value) -> Result x a -> Result x b -> Result x value
map2 :: (a -> b -> value) -> Result x a -> Result x b -> Result x value
map2 =
  (a -> b -> value) -> Result x a -> Result x b -> Result x value
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
Shortcut.map2

-- |
map3 :: (a -> b -> c -> value) -> Result x a -> Result x b -> Result x c -> Result x value
map3 :: (a -> b -> c -> value)
-> Result x a -> Result x b -> Result x c -> Result x value
map3 =
  (a -> b -> c -> value)
-> Result x a -> Result x b -> Result x c -> Result x value
forall (m :: * -> *) a b c value.
Applicative m =>
(a -> b -> c -> value) -> m a -> m b -> m c -> m value
Shortcut.map3

-- |
map4 :: (a -> b -> c -> d -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x value
map4 :: (a -> b -> c -> d -> value)
-> Result x a
-> Result x b
-> Result x c
-> Result x d
-> Result x value
map4 =
  (a -> b -> c -> d -> value)
-> Result x a
-> Result x b
-> Result x c
-> Result x d
-> Result x value
forall (m :: * -> *) a b c d value.
Applicative m =>
(a -> b -> c -> d -> value) -> m a -> m b -> m c -> m d -> m value
Shortcut.map4

-- |
map5 :: (a -> b -> c -> d -> e -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x e -> Result x value
map5 :: (a -> b -> c -> d -> e -> value)
-> Result x a
-> Result x b
-> Result x c
-> Result x d
-> Result x e
-> Result x value
map5 =
  (a -> b -> c -> d -> e -> value)
-> Result x a
-> Result x b
-> Result x c
-> Result x d
-> Result x e
-> Result x value
forall (m :: * -> *) a b c d e value.
Applicative m =>
(a -> b -> c -> d -> e -> value)
-> m a -> m b -> m c -> m d -> m e -> m value
Shortcut.map5

-- | Chain together a sequence of computations that may fail. It is helpful
-- to see its definition:
--
-- > andThen : (a -> Result e b) -> Result e a -> Result e b
-- > andThen callback result =
-- >     case result of
-- >       Ok value -> callback value
-- >       Err msg -> Err msg
--
-- This means we only continue with the callback if things are going well. For
-- example, say you need to use (@toInt : String -> Result String Int@) to parse
-- a month and make sure it is between 1 and 12:
--
-- > toValidMonth : Int -> Result String Int
-- > toValidMonth month =
-- >     if month >= 1 && month <= 12
-- >         then Ok month
-- >         else Err "months must be between 1 and 12"
--
-- > toMonth : String -> Result String Int
-- > toMonth rawString =
-- >     toInt rawString
-- >       |> andThen toValidMonth
--
-- > -- toMonth "4" == Ok 4
-- > -- toMonth "9" == Ok 9
-- > -- toMonth "a" == Err "cannot parse to an Int"
-- > -- toMonth "0" == Err "months must be between 1 and 12"
--
-- This allows us to come out of a chain of operations with quite a specific error
-- message. It is often best to create a custom type that explicitly represents
-- the exact ways your computation may fail. This way it is easy to handle in your
-- code.
andThen :: (a -> Result c b) -> Result c a -> Result c b
andThen :: (a -> Result c b) -> Result c a -> Result c b
andThen =
  (a -> Result c b) -> Result c a -> Result c b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
Shortcut.andThen

-- | Transform an @Err@ value. For example, say the errors we get have too much
-- information:
--
-- > parseInt : String -> Result ParseError Int
-- >
-- > type alias ParseError =
-- >     { message : String
-- >     , code : Int
-- >     , position : (Int,Int)
-- >     }
-- >
-- > mapError .message (parseInt "123") == Ok 123
-- > mapError .message (parseInt "abc") == Err "char 'a' is not a number"
mapError :: (a -> b) -> Result a c -> Result b c
mapError :: (a -> b) -> Result a c -> Result b c
mapError a -> b
func Result a c
result =
  case Result a c
result of
    Ok c
value -> c -> Result b c
forall error value. value -> Result error value
Ok c
value
    Err a
error -> b -> Result b c
forall error value. error -> Result error value
Err (a -> b
func a
error)

-- | Convert to a simpler @Maybe@ if the actual error message is not needed or
-- you need to interact with some code that primarily uses maybes.
--
-- > parseInt : String -> Result ParseError Int
-- >
-- > maybeParseInt : String -> Maybe Int
-- > maybeParseInt string =
-- >     toMaybe (parseInt string)
toMaybe :: Result a b -> Maybe b
toMaybe :: Result a b -> Maybe b
toMaybe Result a b
result =
  case Result a b
result of
    Ok b
value -> b -> Maybe b
forall a. a -> Maybe a
Just b
value
    Err a
_ -> Maybe b
forall a. Maybe a
Nothing

-- | Convert from a simple @Maybe@ to interact with some code that primarily
-- uses @Results@.
--
-- > parseInt : String -> Maybe Int
-- >
-- > resultParseInt : String -> Result String Int
-- > resultParseInt string =
-- >     fromMaybe ("error parsing string: " ++ toString string) (parseInt string)
fromMaybe :: a -> Maybe b -> Result a b
fromMaybe :: a -> Maybe b -> Result a b
fromMaybe a
error Maybe b
maybe =
  case Maybe b
maybe of
    Just b
something -> b -> Result a b
forall error value. value -> Result error value
Ok b
something
    Maybe b
Nothing -> a -> Result a b
forall error value. error -> Result error value
Err a
error