From 11052951b74b9ad4b6a9412ae490086235f9154b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Jan 2021 13:40:40 +0100
Subject: Rewrite in Rust

---
 validation/src/Data/Validation.hs | 375 --------------------------------------
 1 file changed, 375 deletions(-)
 delete mode 100644 validation/src/Data/Validation.hs

(limited to 'validation/src/Data/Validation.hs')

diff --git a/validation/src/Data/Validation.hs b/validation/src/Data/Validation.hs
deleted file mode 100644
index e30202f..0000000
--- a/validation/src/Data/Validation.hs
+++ /dev/null
@@ -1,375 +0,0 @@
-{-# LANGUAGE CPP                #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE TypeFamilies       #-}
-
-#if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE DeriveGeneric      #-}
-#endif
-
--- | 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
-  -- <https://github.com/qfpl/validation/blob/master/examples/src/PolymorphicEmail.hs here>
-, _Failure
-, _Success
-  -- * Isomorphisms
-, 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, Swapped (..), from, iso)
-import           Control.Lens.Prism  (Prism, prism)
-import           Control.Lens.Review (( # ))
-import           Data.Bifoldable     (Bifoldable (bifoldr))
-import           Data.Bifunctor      (Bifunctor (bimap))
-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)
-#if __GLASGOW_HASKELL__ >= 702
-import           GHC.Generics        (Generic)
-#endif
-import           Prelude             (Maybe (..), Show)
-
-
--- | An @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.Monad.Monad' 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 <https://github.com/qfpl/validation/blob/master/examples/src/Email.hs here>.
---
-data Validation err a =
-  Failure err
-  | Success a
-  deriving (
-    Eq, Ord, Show, Data, Typeable
-#if __GLASGOW_HASKELL__ >= 702
-    , Generic
-#endif
-  )
-
-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 #-}
-
-instance Swapped Validation where
-  swapped =
-    iso
-      (\v -> case v of
-        Failure e -> Success e
-        Success a -> Failure a)
-      (\v -> case v of
-        Failure a -> Success a
-        Success e -> Failure e)
-  {-# INLINE swapped #-}
-
-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@.
-validation :: (e -> c) -> (a -> c) -> Validation e a -> c
-validation ec ac v = case v of
-  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 @e@ 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 $ \v -> case v of
-    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 f = under _Validation f
-
--- | @bindValidation@ binds through an 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 =
-    iso
-      (\x -> case x ^. _Validation of
-        Failure e -> Left e
-        Success a -> Right a)
-      (\x -> _Validation # case x of
-        Left e  -> Failure e
-        Right a -> Success a)
-  {-# INLINE _Either #-}
-
-instance Validate Validation where
-  _Validation =
-    id
-  {-# INLINE _Validation #-}
-  _Either =
-    iso
-      (\x -> case x of
-        Failure e -> Left e
-        Success a -> Right a)
-      (\x -> case x of
-        Left e  -> Failure e
-        Right a -> Success a)
-  {-# INLINE _Either #-}
-
-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 =
-  prism
-    (\x -> _Either # Left x)
-    (\x -> case x ^. _Either of
-             Left e  -> Right e
-             Right a -> Left (_Either # Right a))
-{-# INLINE _Failure #-}
-
--- | This prism generalises 'Control.Lens.Prism._Right'. It targets the success case of either 'Either' or 'Validation'.
-_Success ::
-  Validate f =>
-  Prism (f e a) (f e b) a b
-_Success =
-  prism
-    (\x -> _Either # Right x)
-    (\x -> case x ^. _Either of
-             Left e  -> Left (_Either # Left e)
-             Right a -> Right a)
-{-# 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
-- 
cgit v1.2.3