# LANGUAGE CPP #
{-# LANGUAGE DeriveDataTypeable #-}
# LANGUAGE DeriveGeneric #
# LANGUAGE LambdaCase #
# LANGUAGE NoImplicitPrelude #
# LANGUAGE TypeFamilies #

-- | A data type similar to @Data.Either@ that accumulates failures.
module Data.Validation
(
  -- * Data type
  Validation(..)
  -- * Constructing validations
, validate
, validationNel
, fromEither
, liftError
  -- * Functions on validations
, validation
, toEither
, orElse
, valueOr
, ensure
, codiagonal
, validationed
, bindValidation
  -- * Prisms
  -- | These prisms are useful for writing code which is polymorphic in its
  -- choice of Either or Validation. This choice can then be made later by a
  -- user, depending on their needs.
  --
  -- An example of this style of usage can be found
  -- < here>
, _Failure
, _Success
  * 
, Validate(..)
, revalidate
) where

import Control.Applicative(Applicative((<*>), pure), (<$>))
import Control.DeepSeq (NFData (rnf))
import Control.Lens (over, under)
import Control.Lens.Getter((^.))
import Control.Lens.Iso(Iso, iso, from
#if !MIN_VERSION_lens(4,20,0)
                       , Swapped(..))
#else
                       )
#endif
import Control.Lens.Prism(Prism, _Left, _Right)
import Control.Lens.Review(( # ))
import Data.Bifoldable(Bifoldable(bifoldr))
import Data.Bifunctor(Bifunctor(bimap))
import Data.Bifunctor.Swap(Swap(..))
import Data.Bitraversable(Bitraversable(bitraverse))
import Data.Data(Data)
import Data.Either(Either(Left, Right), either)
import Data.Eq(Eq)
import Data.Foldable(Foldable(foldr))
import Data.Function((.), ($), id)
import Data.Functor(Functor(fmap))
import Data.Functor.Alt(Alt((<!>)))
import Data.Functor.Apply(Apply((<.>)))
import Data.List.NonEmpty (NonEmpty)
import Data.Monoid(Monoid(mappend, mempty))
import Data.Ord(Ord)
import Data.Semigroup(Semigroup((<>)))
import Data.Traversable(Traversable(traverse))
import Data.Typeable(Typeable)
import GHC.Generics (Generic)
import Prelude(Show, Maybe(..))


-- | A @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However,
-- the 'Applicative' instance for @Validation@ /accumulates/ errors using a 'Semigroup' on @err@.
  In contrast , the @Applicative@ for @Either@ returns only the first error .
--
  A consequence of this is that @Validation@ has no ' Data . Functor . Bind . Bind ' or ' Control .  .  ' instance . This is because
  such an instance would violate the law that a Monad 's ' Control.Monad.ap ' must equal the
  @Applicative@ 's ' Control . Applicative . < * > '
--
-- An example of typical usage can be found < here>.
--
data Validation err a =
  Failure err
  | Success a
  deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Functor (Validation err) where
  fmap _ (Failure e) =
    Failure e
  fmap f (Success a) =
    Success (f a)
# INLINE fmap #

instance Semigroup err => Apply (Validation err) where
  Failure e1 <.> b = Failure $ case b of
    Failure e2 -> e1 <> e2
    Success _ -> e1
  Success _  <.> Failure e2 =
    Failure e2
  Success f  <.> Success a  =
    Success (f a)
  {-# INLINE (<.>) #-}

instance Semigroup err => Applicative (Validation err) where
  pure =
    Success
  (<*>) =
    (<.>)

  | For two errors , this instance reports only the last of them .
instance Alt (Validation err) where
  Failure _ <!> x =
    x
  Success a <!> _ =
    Success a
  {-# INLINE (<!>) #-}

instance Foldable (Validation err) where
  foldr f x (Success a) =
    f a x
  foldr _ x (Failure _) =
    x
# INLINE foldr #

instance Traversable (Validation err) where
  traverse f (Success a) =
    Success <$> f a
  traverse _ (Failure e) =
    pure (Failure e)
  {-# INLINE traverse #-}

instance Bifunctor Validation where
  bimap f _ (Failure e) =
    Failure (f e)
  bimap _ g (Success a) =
    Success (g a)
# INLINE bimap #


instance Bifoldable Validation where
  bifoldr _ g x (Success a) =
    g a x
  bifoldr f _ x (Failure e) =
    f e x
# INLINE bifoldr #

instance Bitraversable Validation where
  bitraverse _ g (Success a) =
    Success <$> g a
  bitraverse f _ (Failure e) =
    Failure <$> f e
# INLINE bitraverse #

appValidation ::
  (err -> err -> err)
  -> Validation err a
  -> Validation err a
  -> Validation err a
appValidation m (Failure e1) (Failure e2) =
  Failure (e1 `m` e2)
appValidation _ (Failure _) (Success a2) =
  Success a2
appValidation _ (Success a1) (Failure _) =
  Success a1
appValidation _ (Success a1) (Success _) =
  Success a1
# INLINE appValidation #

instance Semigroup e => Semigroup (Validation e a) where
  (<>) =
    appValidation (<>)
  {-# INLINE (<>) #-}

instance Monoid e => Monoid (Validation e a) where
  mappend =
    appValidation mappend
# INLINE mappend #
  mempty =
    Failure mempty
# INLINE mempty #

#if !MIN_VERSION_lens(4,20,0)
instance Swapped Validation where
  swapped = iso swap swap
  {-# INLINE swapped #-}
#endif

instance Swap Validation where
  swap v =
    case v of
      Failure e -> Success e
      Success a -> Failure a
# INLINE swap #

instance (NFData e, NFData a) => NFData (Validation e a) where
  rnf v =
    case v of
      Failure e -> rnf e
      Success a -> rnf a

-- | 'validate's an @a@ producing an updated optional value, returning
-- @e@ in the empty case.
--
-- This can be thought of as having the less general type:
--
-- @
-- validate :: e -> (a -> Maybe b) -> a -> Validation e b
-- @
validate :: Validate v => e -> (a -> Maybe b) -> a -> v e b
validate e p a = case p a of
  Nothing -> _Failure # e
  Just b  -> _Success # b

  | ' validationNel ' is ' liftError ' specialised to ' NonEmpty ' lists , since
-- they are a common semigroup to use.
validationNel :: Either e a -> Validation (NonEmpty e) a
validationNel = liftError pure

-- | Converts from 'Either' to 'Validation'.
fromEither :: Either e a -> Validation e a
fromEither = liftError id

-- | 'liftError' is useful for converting an 'Either' to an 'Validation'
-- when the @Left@ of the 'Either' needs to be lifted into a 'Semigroup'.
liftError :: (b -> e) -> Either b a -> Validation e a
liftError f = either (Failure . f) Success

  | ' validation ' is the catamorphism for 
validation :: (e -> c) -> (a -> c) -> Validation e a -> c
validation ec ac = \case
  Failure e -> ec e
  Success a -> ac a

-- | Converts from 'Validation' to 'Either'.
toEither :: Validation e a -> Either e a
toEither = validation Left Right

  | @v ' orElse ' a@ returns @a@ when @v@ is Failure , and the @a@ in @Success a@.
--
-- This can be thought of as having the less general type:
--
-- @
-- orElse :: Validation e a -> a -> a
-- @
orElse :: Validate v => v e a -> a -> a
orElse v a = case v ^. _Validation of
  Failure _ -> a
  Success x -> x

  | Return the @a@ or run the given function over the @e@.
--
-- This can be thought of as having the less general type:
--
-- @
-- valueOr :: (e -> a) -> Validation e a -> a
-- @
valueOr :: Validate v => (e -> a) -> v e a -> a
valueOr ea v = case v ^. _Validation of
  Failure e -> ea e
  Success a -> a

-- | 'codiagonal' gets the value out of either side.
codiagonal :: Validation a a -> a
codiagonal = valueOr id

-- | 'ensure' ensures that a validation remains unchanged upon failure,
-- updating a successful validation with an optional value that could fail
  with  otherwise .
--
-- This can be thought of as having the less general type:
--
-- @
-- ensure :: e -> (a -> Maybe b) -> Validation e a -> Validation e b
-- @
ensure :: Validate v => e -> (a -> Maybe b) -> v e a -> v e b
ensure e p =
  over _Validation $ \case
    Failure x -> Failure x
    Success a -> validate e p a

  | Run a function on anything with a Validate instance ( usually Either )
-- as if it were a function on Validation
--
-- This can be thought of as having the type
--
  @(Either e a - > Either e ' a ' ) - > Validation e a - > Validation e ' a'@
validationed :: Validate v => (v e a -> v e' a') -> Validation e a -> Validation e' a'
validationed = under _Validation

-- | @bindValidation@ binds through a Validation, which is useful for
  composing Validations sequentially . Note that despite having a bind
-- function of the correct type, Validation is not a monad.
-- The reason is, this bind does not accumulate errors, so it does not
-- agree with the Applicative instance.
--
-- There is nothing wrong with using this function, it just does not make a
  valid @Monad@ instance .
bindValidation :: Validation e a -> (a -> Validation e b) -> Validation e b
bindValidation v f = case v of
  Failure e -> Failure e
  Success a -> f a

  | The @Validate@ class carries around witnesses that the type @f@ is isomorphic
-- to Validation, and hence isomorphic to Either.
class Validate f where
  _Validation ::
    Iso (f e a) (f g b) (Validation e a) (Validation g b)

  _Either ::
    Iso (f e a) (f g b) (Either e a) (Either g b)
  _Either = _Validation . iso toEither fromEither
  {-# INLINE _Either #-}

instance Validate Validation where
  _Validation =
    id
# INLINE _ Validation #

instance Validate Either where
  _Validation =
    iso
      fromEither
      toEither
# INLINE _ Validation #
  _Either =
    id
  {-# INLINE _Either #-}

  | This prism generalises ' Control . Lens . Prism._Left ' . It targets the failure case of either ' Either ' or ' Validation ' .
_Failure ::
  Validate f =>
  Prism (f e1 a) (f e2 a) e1 e2
_Failure = _Either . _Left
{-# INLINE _Failure #-}

  | This prism generalises ' Control . Lens .  ' . It targets the success case of either ' Either ' or ' Validation ' .
_Success ::
  Validate f =>
  Prism (f e a) (f e b) a b
_Success = _Either . _Right
# INLINE _ Success #

  | ' revalidate ' converts between any two instances of ' Validate ' .
revalidate :: (Validate f, Validate g) => Iso (f e1 s) (f e2 t) (g e1 s) (g e2 t)
revalidate = _Validation . from _Validation

# LANGUAGE DeriveDataTypeable #
 | A data type similar to @Data.Either@ that accumulates failures.
 * Data type
 * Constructing validations
 * Functions on validations
 * Prisms
 | These prisms are useful for writing code which is polymorphic in its
 choice of Either or Validation. This choice can then be made later by a
 user, depending on their needs.

 An example of this style of usage can be found
 < here>
 | A @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However,
 the 'Applicative' instance for @Validation@ /accumulates/ errors using a 'Semigroup' on @err@.


 An example of typical usage can be found < here>.

# INLINE (<.>) #
# INLINE (<!>) #
# INLINE traverse #
# INLINE (<>) #
# INLINE swapped #
 | 'validate's an @a@ producing an updated optional value, returning
 @e@ in the empty case.

 This can be thought of as having the less general type:

 @
 validate :: e -> (a -> Maybe b) -> a -> Validation e b
 @
 they are a common semigroup to use.
 | Converts from 'Either' to 'Validation'.
 | 'liftError' is useful for converting an 'Either' to an 'Validation'
 when the @Left@ of the 'Either' needs to be lifted into a 'Semigroup'.
 | Converts from 'Validation' to 'Either'.

 This can be thought of as having the less general type:

 @
 orElse :: Validation e a -> a -> a
 @

 This can be thought of as having the less general type:

 @
 valueOr :: (e -> a) -> Validation e a -> a
 @
 | 'codiagonal' gets the value out of either side.
 | 'ensure' ensures that a validation remains unchanged upon failure,
 updating a successful validation with an optional value that could fail

 This can be thought of as having the less general type:

 @
 ensure :: e -> (a -> Maybe b) -> Validation e a -> Validation e b
 @
 as if it were a function on Validation

 This can be thought of as having the type

 | @bindValidation@ binds through a Validation, which is useful for
 function of the correct type, Validation is not a monad.
 The reason is, this bind does not accumulate errors, so it does not
 agree with the Applicative instance.

 There is nothing wrong with using this function, it just does not make a
 to Validation, and hence isomorphic to Either.
# INLINE _Either #
# INLINE _Either #
# INLINE _Failure #
# LANGUAGE CPP #
# LANGUAGE DeriveGeneric #
# LANGUAGE LambdaCase #
# LANGUAGE NoImplicitPrelude #
# LANGUAGE TypeFamilies #

module Data.Validation
(
  Validation(..)
, validate
, validationNel
, fromEither
, liftError
, validation
, toEither
, orElse
, valueOr
, ensure
, codiagonal
, validationed
, bindValidation
, _Failure
, _Success
  * 
, Validate(..)
, revalidate
) where

import Control.Applicative(Applicative((<*>), pure), (<$>))
import Control.DeepSeq (NFData (rnf))
import Control.Lens (over, under)
import Control.Lens.Getter((^.))
import Control.Lens.Iso(Iso, iso, from
#if !MIN_VERSION_lens(4,20,0)
                       , Swapped(..))
#else
                       )
#endif
import Control.Lens.Prism(Prism, _Left, _Right)
import Control.Lens.Review(( # ))
import Data.Bifoldable(Bifoldable(bifoldr))
import Data.Bifunctor(Bifunctor(bimap))
import Data.Bifunctor.Swap(Swap(..))
import Data.Bitraversable(Bitraversable(bitraverse))
import Data.Data(Data)
import Data.Either(Either(Left, Right), either)
import Data.Eq(Eq)
import Data.Foldable(Foldable(foldr))
import Data.Function((.), ($), id)
import Data.Functor(Functor(fmap))
import Data.Functor.Alt(Alt((<!>)))
import Data.Functor.Apply(Apply((<.>)))
import Data.List.NonEmpty (NonEmpty)
import Data.Monoid(Monoid(mappend, mempty))
import Data.Ord(Ord)
import Data.Semigroup(Semigroup((<>)))
import Data.Traversable(Traversable(traverse))
import Data.Typeable(Typeable)
import GHC.Generics (Generic)
import Prelude(Show, Maybe(..))


  In contrast , the @Applicative@ for @Either@ returns only the first error .
  A consequence of this is that @Validation@ has no ' Data . Functor . Bind . Bind ' or ' Control .  .  ' instance . This is because
  such an instance would violate the law that a Monad 's ' Control.Monad.ap ' must equal the
  @Applicative@ 's ' Control . Applicative . < * > '
data Validation err a =
  Failure err
  | Success a
  deriving (Data, Eq, Generic, Ord, Show, Typeable)

instance Functor (Validation err) where
  fmap _ (Failure e) =
    Failure e
  fmap f (Success a) =
    Success (f a)
# INLINE fmap #

instance Semigroup err => Apply (Validation err) where
  Failure e1 <.> b = Failure $ case b of
    Failure e2 -> e1 <> e2
    Success _ -> e1
  Success _  <.> Failure e2 =
    Failure e2
  Success f  <.> Success a  =
    Success (f a)

instance Semigroup err => Applicative (Validation err) where
  pure =
    Success
  (<*>) =
    (<.>)

  | For two errors , this instance reports only the last of them .
instance Alt (Validation err) where
  Failure _ <!> x =
    x
  Success a <!> _ =
    Success a

instance Foldable (Validation err) where
  foldr f x (Success a) =
    f a x
  foldr _ x (Failure _) =
    x
# INLINE foldr #

instance Traversable (Validation err) where
  traverse f (Success a) =
    Success <$> f a
  traverse _ (Failure e) =
    pure (Failure e)

instance Bifunctor Validation where
  bimap f _ (Failure e) =
    Failure (f e)
  bimap _ g (Success a) =
    Success (g a)
# INLINE bimap #


instance Bifoldable Validation where
  bifoldr _ g x (Success a) =
    g a x
  bifoldr f _ x (Failure e) =
    f e x
# INLINE bifoldr #

instance Bitraversable Validation where
  bitraverse _ g (Success a) =
    Success <$> g a
  bitraverse f _ (Failure e) =
    Failure <$> f e
# INLINE bitraverse #

appValidation ::
  (err -> err -> err)
  -> Validation err a
  -> Validation err a
  -> Validation err a
appValidation m (Failure e1) (Failure e2) =
  Failure (e1 `m` e2)
appValidation _ (Failure _) (Success a2) =
  Success a2
appValidation _ (Success a1) (Failure _) =
  Success a1
appValidation _ (Success a1) (Success _) =
  Success a1
# INLINE appValidation #

instance Semigroup e => Semigroup (Validation e a) where
  (<>) =
    appValidation (<>)

instance Monoid e => Monoid (Validation e a) where
  mappend =
    appValidation mappend
# INLINE mappend #
  mempty =
    Failure mempty
# INLINE mempty #

#if !MIN_VERSION_lens(4,20,0)
instance Swapped Validation where
  swapped = iso swap swap
#endif

instance Swap Validation where
  swap v =
    case v of
      Failure e -> Success e
      Success a -> Failure a
# INLINE swap #

instance (NFData e, NFData a) => NFData (Validation e a) where
  rnf v =
    case v of
      Failure e -> rnf e
      Success a -> rnf a

validate :: Validate v => e -> (a -> Maybe b) -> a -> v e b
validate e p a = case p a of
  Nothing -> _Failure # e
  Just b  -> _Success # b

  | ' validationNel ' is ' liftError ' specialised to ' NonEmpty ' lists , since
validationNel :: Either e a -> Validation (NonEmpty e) a
validationNel = liftError pure

fromEither :: Either e a -> Validation e a
fromEither = liftError id

liftError :: (b -> e) -> Either b a -> Validation e a
liftError f = either (Failure . f) Success

  | ' validation ' is the catamorphism for 
validation :: (e -> c) -> (a -> c) -> Validation e a -> c
validation ec ac = \case
  Failure e -> ec e
  Success a -> ac a

toEither :: Validation e a -> Either e a
toEither = validation Left Right

  | @v ' orElse ' a@ returns @a@ when @v@ is Failure , and the @a@ in @Success a@.
orElse :: Validate v => v e a -> a -> a
orElse v a = case v ^. _Validation of
  Failure _ -> a
  Success x -> x

  | Return the @a@ or run the given function over the @e@.
valueOr :: Validate v => (e -> a) -> v e a -> a
valueOr ea v = case v ^. _Validation of
  Failure e -> ea e
  Success a -> a

codiagonal :: Validation a a -> a
codiagonal = valueOr id

  with  otherwise .
ensure :: Validate v => e -> (a -> Maybe b) -> v e a -> v e b
ensure e p =
  over _Validation $ \case
    Failure x -> Failure x
    Success a -> validate e p a

  | Run a function on anything with a Validate instance ( usually Either )
  @(Either e a - > Either e ' a ' ) - > Validation e a - > Validation e ' a'@
validationed :: Validate v => (v e a -> v e' a') -> Validation e a -> Validation e' a'
validationed = under _Validation

  composing Validations sequentially . Note that despite having a bind
  valid @Monad@ instance .
bindValidation :: Validation e a -> (a -> Validation e b) -> Validation e b
bindValidation v f = case v of
  Failure e -> Failure e
  Success a -> f a

  | The @Validate@ class carries around witnesses that the type @f@ is isomorphic
class Validate f where
  _Validation ::
    Iso (f e a) (f g b) (Validation e a) (Validation g b)

  _Either ::
    Iso (f e a) (f g b) (Either e a) (Either g b)
  _Either = _Validation . iso toEither fromEither

instance Validate Validation where
  _Validation =
    id
# INLINE _ Validation #

instance Validate Either where
  _Validation =
    iso
      fromEither
      toEither
# INLINE _ Validation #
  _Either =
    id

  | This prism generalises ' Control . Lens . Prism._Left ' . It targets the failure case of either ' Either ' or ' Validation ' .
_Failure ::
  Validate f =>
  Prism (f e1 a) (f e2 a) e1 e2
_Failure = _Either . _Left

  | This prism generalises ' Control . Lens .  ' . It targets the success case of either ' Either ' or ' Validation ' .
_Success ::
  Validate f =>
  Prism (f e a) (f e b) a b
_Success = _Either . _Right
# INLINE _ Success #

  | ' revalidate ' converts between any two instances of ' Validate ' .
revalidate :: (Validate f, Validate g) => Iso (f e1 s) (f e2 t) (g e1 s) (g e2 t)
revalidate = _Validation . from _Validation
