{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
module Env.Internal.Val
  ( Val(..)
  , fromEither
  , toEither
  ) where

import Control.Applicative
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(..))
#endif
import Data.Monoid ((<>))


-- | A type isomorphic to 'Either' with the accumulating 'Applicative' instance.
data Val e a
  = Err e
  | Ok  a
    deriving (a -> Val e b -> Val e a
(a -> b) -> Val e a -> Val e b
(forall a b. (a -> b) -> Val e a -> Val e b)
-> (forall a b. a -> Val e b -> Val e a) -> Functor (Val e)
forall a b. a -> Val e b -> Val e a
forall a b. (a -> b) -> Val e a -> Val e b
forall e a b. a -> Val e b -> Val e a
forall e a b. (a -> b) -> Val e a -> Val e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Val e b -> Val e a
$c<$ :: forall e a b. a -> Val e b -> Val e a
fmap :: (a -> b) -> Val e a -> Val e b
$cfmap :: forall e a b. (a -> b) -> Val e a -> Val e b
Functor, Int -> Val e a -> ShowS
[Val e a] -> ShowS
Val e a -> String
(Int -> Val e a -> ShowS)
-> (Val e a -> String) -> ([Val e a] -> ShowS) -> Show (Val e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Val e a -> ShowS
forall e a. (Show e, Show a) => [Val e a] -> ShowS
forall e a. (Show e, Show a) => Val e a -> String
showList :: [Val e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Val e a] -> ShowS
show :: Val e a -> String
$cshow :: forall e a. (Show e, Show a) => Val e a -> String
showsPrec :: Int -> Val e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Val e a -> ShowS
Show, Val e a -> Val e a -> Bool
(Val e a -> Val e a -> Bool)
-> (Val e a -> Val e a -> Bool) -> Eq (Val e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Val e a -> Val e a -> Bool
/= :: Val e a -> Val e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Val e a -> Val e a -> Bool
== :: Val e a -> Val e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Val e a -> Val e a -> Bool
Eq)

instance Monoid e => Applicative (Val e) where
  pure :: a -> Val e a
pure = a -> Val e a
forall e a. a -> Val e a
Ok

  Err e
e <*> :: Val e (a -> b) -> Val e a -> Val e b
<*> Err e
e' = e -> Val e b
forall e a. e -> Val e a
Err (e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e')
  Err e
e <*> Val e a
_      = e -> Val e b
forall e a. e -> Val e a
Err e
e
  Val e (a -> b)
_     <*> Err e
e' = e -> Val e b
forall e a. e -> Val e a
Err e
e'
  Ok  a -> b
f <*> Ok  a
a  = b -> Val e b
forall e a. a -> Val e a
Ok (a -> b
f a
a)

instance Monoid e => Alternative (Val e) where
  empty :: Val e a
empty = e -> Val e a
forall e a. e -> Val e a
Err e
forall a. Monoid a => a
mempty

  Err e
_ <|> :: Val e a -> Val e a -> Val e a
<|> Ok a
x = a -> Val e a
forall e a. a -> Val e a
Ok a
x
  Val e a
x     <|> Val e a
_    = Val e a
x

fromEither :: Either e a -> Val e a
fromEither :: Either e a -> Val e a
fromEither =
  (e -> Val e a) -> (a -> Val e a) -> Either e a -> Val e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Val e a
forall e a. e -> Val e a
Err a -> Val e a
forall e a. a -> Val e a
Ok

toEither :: Val e a -> Either e a
toEither :: Val e a -> Either e a
toEither Val e a
x =
  case Val e a
x of Err e
e -> e -> Either e a
forall a b. a -> Either a b
Left e
e; Ok a
a -> a -> Either e a
forall a b. b -> Either a b
Right a
a