validation 0.4.0 → 0.4.1
raw patch · 4 files changed
+588/−230 lines, 4 filesdep +template-haskell
Dependencies added: template-haskell
Files
- LICENSE +2/−1
- changelog +11/−0
- src/Data/Validation.hs +560/−218
- validation.cabal +15/−11
LICENSE view
@@ -1,4 +1,5 @@-Copyright 2010-2012 Tony Morris, Nick Partridge+Copyright 2010-2013 Tony Morris, Nick Partridge+Copyright 2014 NICTA Limited All rights reserved.
changelog view
@@ -1,3 +1,14 @@+0.4.1++* Remove `Alternative` instances. They are obscene.+* INLINE pragmas++0.4.0++* Change the premise of the `Validate` type-class to more strongly reflect the isomorphism to Either.+* The `_Failure` and `_Success` prisms are now derived.+* Lots more examples+ 0.3.0 A restructuring of 0.2.x where:
src/Data/Validation.hs view
@@ -17,29 +17,29 @@ , Validate(..) ) where -import Control.Applicative(Applicative(..), Alternative(..), liftA2, (<$>))-import Control.Lens((^.))-import Control.Lens.Prism(Prism, prism)+import Control.Applicative(Applicative((<*>), pure), liftA2, (<$>))+import Control.Lens.Getter((^.)) import Control.Lens.Iso(Swapped(..), Iso, iso)+import Control.Lens.Prism(Prism, prism) import Control.Lens.Review(( # ))-import Control.Monad(Monad(..))-import Data.Bifoldable(Bifoldable(..))-import Data.Bifunctor(Bifunctor(..))-import Data.Bitraversable(Bitraversable(..))+import Control.Monad(Monad((>>=), return))+import Data.Bifoldable(Bifoldable(bifoldr))+import Data.Bifunctor(Bifunctor(bimap))+import Data.Bitraversable(Bitraversable(bitraverse)) import Data.Data(Data)-import Data.Either(Either(..))+import Data.Either(Either(Left, Right)) import Data.Eq(Eq)-import Data.Foldable(Foldable(..))+import Data.Foldable(Foldable(foldr)) import Data.Function((.), id, flip)-import Data.Functor(Functor(..))-import Data.Functor.Alt(Alt(..))-import Data.Functor.Apply(Apply(..))-import Data.Functor.Bind(Bind(..), liftF2)-import Data.Functor.Identity(Identity(..))-import Data.Monoid(Monoid(..))+import Data.Functor(Functor(fmap))+import Data.Functor.Alt(Alt((<!>)))+import Data.Functor.Apply(Apply((<.>)))+import Data.Functor.Bind(Bind((>>-)), liftF2)+import Data.Functor.Identity(Identity(Identity))+import Data.Monoid(Monoid(mappend, mempty)) import Data.Ord(Ord)-import Data.Semigroup(Semigroup(..))-import Data.Traversable(Traversable(..))+import Data.Semigroup(Semigroup((<>)))+import Data.Traversable(Traversable(traverse)) import Data.Typeable(Typeable) import Prelude(Show) @@ -74,21 +74,38 @@ | AccSuccess a deriving (Eq, Ord, Show, Data, Typeable) +fmapAccValidation ::+ (a -> b)+ -> AccValidation err a+ -> AccValidation err b+fmapAccValidation _ (AccFailure e) =+ AccFailure e+fmapAccValidation f (AccSuccess a) =+ AccSuccess (f a)+{-# INLINE fmapAccValidation #-}+ instance Functor (AccValidation err) where- fmap _ (AccFailure e) =- AccFailure e- fmap f (AccSuccess a) =- AccSuccess (f a)+ fmap =+ fmapAccValidation +apAccValidation ::+ Semigroup err =>+ AccValidation err (a -> b)+ -> AccValidation err a+ -> AccValidation err b+AccFailure e1 `apAccValidation` AccFailure e2 =+ AccFailure (e1 <> e2)+AccFailure e1 `apAccValidation` AccSuccess _ =+ AccFailure e1+AccSuccess _ `apAccValidation` AccFailure e2 =+ AccFailure e2+AccSuccess f `apAccValidation` AccSuccess a =+ AccSuccess (f a)+{-# INLINE apAccValidation #-}+ instance Semigroup err => Apply (AccValidation err) where- AccFailure e1 <.> AccFailure e2 =- AccFailure (e1 <> e2)- AccFailure e1 <.> AccSuccess _ =- AccFailure e1- AccSuccess _ <.> AccFailure e2 =- AccFailure e2- AccSuccess f <.> AccSuccess a =- AccSuccess (f a)+ (<.>) =+ apAccValidation instance Semigroup err => Applicative (AccValidation err) where pure =@@ -96,63 +113,140 @@ (<*>) = (<.>) +altAccValidation ::+ AccValidation err a+ -> AccValidation err a+ -> AccValidation err a+AccFailure _ `altAccValidation` x =+ x+AccSuccess a `altAccValidation` _ =+ AccSuccess a+{-# INLINE altAccValidation #-}+ instance Semigroup err => Alt (AccValidation err) where- AccFailure _ <!> x =- x- AccSuccess a <!> _ =- AccSuccess a+ (<!>) =+ altAccValidation -instance (Semigroup err, Monoid err) => Alternative (AccValidation err) where- AccFailure _ <|> x =- x- AccSuccess a <|> _ =- AccSuccess a- empty =- AccFailure mempty+foldrAccValidation ::+ (a -> b -> b)+ -> b+ -> AccValidation err a -> b+foldrAccValidation f x (AccSuccess a) =+ f a x+foldrAccValidation _ x (AccFailure _) =+ x+{-# INLINE foldrAccValidation #-} instance Foldable (AccValidation err) where- foldr f x (AccSuccess a) =- f a x- foldr _ x (AccFailure _) =- x+ foldr =+ foldrAccValidation -instance Traversable (AccValidation err) where- traverse f (AccSuccess a) =+traverseAccValidation ::+ Applicative f =>+ (a -> f b)+ -> AccValidation err a+ -> f (AccValidation err b)+traverseAccValidation f (AccSuccess a) = AccSuccess <$> f a- traverse _ (AccFailure e) =- pure (AccFailure e)+traverseAccValidation _ (AccFailure e) =+ pure (AccFailure e)+{-# INLINE traverseAccValidation #-} +instance Traversable (AccValidation err) where+ traverse =+ traverseAccValidation++bimapAccValidation ::+ (err -> f)+ -> (a -> b)+ -> AccValidation err a+ -> AccValidation f b+bimapAccValidation f _ (AccFailure e) =+ AccFailure (f e)+bimapAccValidation _ g (AccSuccess a) =+ AccSuccess (g a)+{-# INLINE bimapAccValidation #-}+ instance Bifunctor AccValidation where- bimap f _ (AccFailure e) =- AccFailure (f e)- bimap _ g (AccSuccess a) =- AccSuccess (g a)+ bimap =+ bimapAccValidation +bifoldrAccValidation ::+ (x -> a -> b)+ -> (y -> a -> b)+ -> a+ -> AccValidation x y+ -> b+bifoldrAccValidation _ g x (AccSuccess a) =+ g a x+bifoldrAccValidation f _ x (AccFailure e) =+ f e x+{-# INLINE bifoldrAccValidation #-}+ instance Bifoldable AccValidation where- bifoldr _ g x (AccSuccess a) =- g a x- bifoldr f _ x (AccFailure e) =- f e x+ bifoldr =+ bifoldrAccValidation +bitraverseAccValidation ::+ Functor f =>+ (x -> f err)+ -> (y -> f a)+ -> AccValidation x y+ -> f (AccValidation err a)+bitraverseAccValidation _ g (AccSuccess a) =+ AccSuccess <$> g a+bitraverseAccValidation f _ (AccFailure e) =+ AccFailure <$> f e+{-# INLINE bitraverseAccValidation #-}+ instance Bitraversable AccValidation where- bitraverse _ g (AccSuccess a) =- AccSuccess <$> g a- bitraverse f _ (AccFailure e) =- AccFailure <$> f e+ bitraverse =+ bitraverseAccValidation +appsAccValidation ::+ Semigroup err =>+ AccValidation err a+ -> AccValidation err a+ -> AccValidation err a+AccFailure e1 `appsAccValidation` AccFailure e2 =+ AccFailure (e1 <> e2)+AccFailure _ `appsAccValidation` AccSuccess a2 =+ AccSuccess a2+AccSuccess a1 `appsAccValidation` AccFailure _ =+ AccSuccess a1+AccSuccess a1 `appsAccValidation` AccSuccess _ =+ AccSuccess a1+{-# INLINE appsAccValidation #-}+ -- | -- -- prop> ((x <> y) <> z) == (x <> (y <> z :: AccValidation [String] Int)) instance Semigroup e => Semigroup (AccValidation e a) where- AccFailure e1 <> AccFailure e2 =- AccFailure (e1 <> e2)- AccFailure _ <> AccSuccess a2 =- AccSuccess a2- AccSuccess a1 <> AccFailure _ =- AccSuccess a1- AccSuccess a1 <> AccSuccess _ =- AccSuccess a1+ (<>) =+ appsAccValidation +appmAccValidation ::+ Monoid err =>+ AccValidation err a+ -> AccValidation err a+ -> AccValidation err a+AccFailure e1 `appmAccValidation` AccFailure e2 =+ AccFailure (e1 `mappend` e2)+AccFailure _ `appmAccValidation` AccSuccess a2 =+ AccSuccess a2+AccSuccess a1 `appmAccValidation` AccFailure _ =+ AccSuccess a1+AccSuccess a1 `appmAccValidation` AccSuccess _ =+ AccSuccess a1+{-# INLINE appmAccValidation #-}++emptyAccValidation ::+ Monoid err =>+ AccValidation err a+emptyAccValidation =+ AccFailure mempty+{-# INLINE emptyAccValidation #-}+ -- | -- -- prop> ((x `mappend` y) `mappend` z) == (x `mappend` (y `mappend` z :: AccValidation [String] Int))@@ -161,16 +255,10 @@ -- -- prop> x `mappend` mempty == (x :: AccValidation [String] Int) instance Monoid e => Monoid (AccValidation e a) where- AccFailure e1 `mappend` AccFailure e2 =- AccFailure (e1 `mappend` e2)- AccFailure _ `mappend` AccSuccess a2 =- AccSuccess a2- AccSuccess a1 `mappend` AccFailure _ =- AccSuccess a1- AccSuccess a1 `mappend` AccSuccess _ =- AccSuccess a1+ mappend =+ appmAccValidation mempty =- AccFailure mempty+ emptyAccValidation -- | A value of the type @err@ or @a@ and isomorphic to @Data.Either@. --@@ -190,81 +278,154 @@ | Success a deriving (Eq, Ord, Show, Data, Typeable) +fmapValidation ::+ (a -> b)+ -> Validation err a+ -> Validation err b+fmapValidation _ (Failure e) =+ Failure e+fmapValidation f (Success a) =+ Success (f a)+{-# INLINE fmapValidation #-}+ instance Functor (Validation err) where- fmap _ (Failure e) = Failure e- fmap f (Success a) = Success (f a)+ fmap =+ fmapValidation +apValidation ::+ Validation err (a -> b)+ -> Validation err a+ -> Validation err b+Failure e1 `apValidation` Failure _ =+ Failure e1+Failure e1 `apValidation` Success _ =+ Failure e1+Success _ `apValidation` Failure e2 =+ Failure e2+Success f `apValidation` Success a =+ Success (f a)+{-# INLINE apValidation #-} + instance Apply (Validation err) where- Failure e1 <.> Failure _ =- Failure e1- Failure e1 <.> Success _ =- Failure e1- Success _ <.> Failure e2 =- Failure e2- Success f <.> Success a =- Success (f a)+ (<.>) =+ apValidation instance Applicative (Validation err) where pure = Success (<*>) =- (<.>)+ apValidation +altValidation ::+ Validation err a+ -> Validation err a+ -> Validation err a+Failure _ `altValidation` x =+ x+Success a `altValidation` _ =+ Success a+{-# INLINE altValidation #-}+ instance Alt (Validation err) where- Failure _ <!> x =- x- Success a <!> _ =- Success a+ (<!>) =+ altValidation -instance Monoid err => Alternative (Validation err) where- Failure _ <|> x =- x- Success a <|> _ =- Success a- empty =- Failure mempty+foldrValidation ::+ (a -> b -> b)+ -> b+ -> Validation err a+ -> b+foldrValidation f x (Success a) =+ f a x+foldrValidation _ x (Failure _) =+ x+{-# INLINE foldrValidation #-} instance Foldable (Validation err) where- foldr f x (Success a) =- f a x- foldr _ x (Failure _) =- x+ foldr =+ foldrValidation +traverseValidation ::+ Applicative f =>+ (a -> f b)+ -> Validation err a+ -> f (Validation err b)+traverseValidation f (Success a) =+ Success <$> f a+traverseValidation _ (Failure e) =+ pure (Failure e)+{-# INLINE traverseValidation #-}+ instance Traversable (Validation err) where- traverse f (Success a) =- Success <$> f a- traverse _ (Failure e) =- pure (Failure e)+ traverse =+ traverseValidation +bimapValidation ::+ (err -> f)+ -> (a -> b)+ -> Validation err a+ -> Validation f b+bimapValidation f _ (Failure e) =+ Failure (f e)+bimapValidation _ g (Success a) =+ Success (g a)+{-# INLINE bimapValidation #-} + instance Bifunctor Validation where- bimap f _ (Failure e) =- Failure (f e)- bimap _ g (Success a) =- Success (g a)+ bimap =+ bimapValidation +bifoldrValidation ::+ (x -> a -> b)+ -> (y -> a -> b)+ -> a+ -> Validation x y+ -> b+bifoldrValidation _ g x (Success a) =+ g a x+bifoldrValidation f _ x (Failure e) =+ f e x+{-# INLINE bifoldrValidation #-}+ instance Bifoldable Validation where- bifoldr _ g x (Success a) =- g a x- bifoldr f _ x (Failure e) =- f e x+ bifoldr =+ bifoldrValidation +bitraverseValidation ::+ Functor f =>+ (x -> f err)+ -> (y -> f a)+ -> Validation x y+ -> f (Validation err a) +bitraverseValidation _ g (Success a) =+ Success <$> g a+bitraverseValidation f _ (Failure e) =+ Failure <$> f e+{-# INLINE bitraverseValidation #-}+ instance Bitraversable Validation where- bitraverse _ g (Success a) =- Success <$> g a- bitraverse f _ (Failure e) =- Failure <$> f e+ bitraverse =+ bitraverseValidation +bindValidation ::+ Validation err a+ -> (a -> Validation err b)+ -> Validation err b+Failure e `bindValidation` _ =+ Failure e+Success a `bindValidation` f =+ f a+{-# INLINE bindValidation #-}+ instance Bind (Validation err) where- Failure e >>- _ =- Failure e- Success a >>- f =- f a+ (>>-) =+ bindValidation instance Monad (Validation err) where return = Success (>>=) =- (>>-)+ bindValidation -- | The transformer version of @Validation@. data ValidationT m err a =@@ -275,130 +436,290 @@ type Validation' err a = ValidationT Identity err a +fmapValidationT ::+ Functor f =>+ (a -> b)+ -> ValidationT f err a+ -> ValidationT f err b+fmapValidationT f (ValidationT k) =+ ValidationT (fmap (fmap f) k)+{-# INLINE fmapValidationT #-}+ instance Functor m => Functor (ValidationT m err) where- fmap f (ValidationT k) =- ValidationT (fmap (fmap f) k)+ fmap =+ fmapValidationT -instance Apply m => Apply (ValidationT m err) where- ValidationT f <.> ValidationT a =+apValidationT ::+ Apply f =>+ ValidationT f err (a -> b)+ -> ValidationT f err a+ -> ValidationT f err b+ValidationT f `apValidationT` ValidationT a = ValidationT (liftF2 (<.>) f a)+{-# INLINE apValidationT #-} +instance Apply m => Apply (ValidationT m err) where+ (<.>) =+ apValidationT++pureValidationT ::+ Applicative f =>+ a+ -> ValidationT f err a+pureValidationT =+ ValidationT . pure . pure+{-# INLINE pureValidationT #-}++aplValidationT ::+ Applicative f =>+ ValidationT f err (a -> b)+ -> ValidationT f err a+ -> ValidationT f err b+ValidationT f `aplValidationT` ValidationT a =+ ValidationT (liftA2 (<*>) f a)+{-# INLINE aplValidationT #-}+ instance Applicative m => Applicative (ValidationT m err) where pure =- ValidationT . pure . pure- ValidationT f <*> ValidationT a =- ValidationT (liftA2 (<*>) f a)+ pureValidationT+ (<*>) =+ aplValidationT +altValidationT ::+ (Functor m, Monad m) =>+ ValidationT m err a+ -> ValidationT m err a+ -> ValidationT m err a+ValidationT x `altValidationT` ValidationT y =+ ValidationT (x >>= \q -> case q of+ Failure _ -> y+ Success a -> return (Success a))+{-# INLINE altValidationT #-}+ instance (Functor m, Monad m) => Alt (ValidationT m err) where- ValidationT x <!> ValidationT y =- ValidationT (x >>= \q -> case q of- Failure _ -> y- Success a -> return (Success a))+ (<!>) =+ altValidationT -instance (Applicative m, Monad m, Monoid err) => Alternative (ValidationT m err) where- ValidationT x <|> ValidationT y =- ValidationT (x >>= \q -> case q of- Failure _ -> y- Success a -> return (Success a))- empty =- ValidationT (pure (Failure mempty))+foldrValidationT ::+ Foldable f =>+ (a -> b -> b)+ -> b+ -> ValidationT f err a+ -> b+foldrValidationT f z (ValidationT x) =+ foldr (flip (foldr f)) z x+{-# INLINE foldrValidationT #-} instance Foldable m => Foldable (ValidationT m err) where- foldr f z (ValidationT x) =- foldr (flip (foldr f)) z x+ foldr =+ foldrValidationT +traverseValidationT ::+ (Traversable g, Applicative f) =>+ (a -> f b)+ -> ValidationT g err a+ -> f (ValidationT g err b)+traverseValidationT f (ValidationT x) =+ ValidationT <$> traverse (traverse f) x+{-# INLINE traverseValidationT #-}+ instance Traversable m => Traversable (ValidationT m err) where- traverse f (ValidationT x) =- ValidationT <$> traverse (traverse f) x+ traverse =+ traverseValidationT +bimapValidationT ::+ Functor f =>+ (err -> frr)+ -> (a -> b)+ -> ValidationT f err a+ -> ValidationT f frr b+bimapValidationT f g (ValidationT x) =+ ValidationT (fmap (bimap f g) x)+{-# INLINE bimapValidationT #-}+ instance Functor m => Bifunctor (ValidationT m) where- bimap f g (ValidationT x) =- ValidationT (fmap (bimap f g) x)+ bimap =+ bimapValidationT +bifoldrValidationT ::+ Foldable f =>+ (err -> b -> b)+ -> (a -> b -> b)+ -> b+ -> ValidationT f err a+ -> b+bifoldrValidationT f g z (ValidationT x) =+ foldr (flip (bifoldr f g)) z x+{-# INLINE bifoldrValidationT #-}+ instance Foldable m => Bifoldable (ValidationT m) where- bifoldr f g z (ValidationT x) =- foldr (flip (bifoldr f g)) z x+ bifoldr =+ bifoldrValidationT +bitraverseValidationT ::+ (Traversable g, Applicative f) =>+ (err -> f frr)+ -> (a -> f b)+ -> ValidationT g err a+ -> f (ValidationT g frr b)+bitraverseValidationT f g (ValidationT x) =+ ValidationT <$> traverse (bitraverse f g) x+{-# INLINE bitraverseValidationT #-}+ instance Traversable m => Bitraversable (ValidationT m) where- bitraverse f g (ValidationT x) =- ValidationT <$> traverse (bitraverse f g) x+ bitraverse =+ bitraverseValidationT +bindValidationT ::+ Monad f =>+ ValidationT f err a+ -> (a -> ValidationT f err b)+ -> ValidationT f err b+ValidationT v `bindValidationT` f =+ ValidationT (v >>= \w -> case w of+ Failure e -> return (Failure e)+ Success a -> runValidationT (f a))+{-# INLINE bindValidationT #-}+ instance (Apply m, Monad m) => Bind (ValidationT m err) where- ValidationT v >>- f =- ValidationT (v >>= \w -> case w of- Failure e -> return (Failure e)- Success a -> runValidationT (f a))+ (>>-) =+ bindValidationT +returnValidationT ::+ Monad f =>+ a+ -> ValidationT f err a+returnValidationT =+ ValidationT . return . pure+{-# INLINE returnValidationT #-}+ instance Monad m => Monad (ValidationT m err) where return =- ValidationT . return . pure- ValidationT v >>= f =- ValidationT (v >>= \w -> case w of- Failure e -> return (Failure e)- Success a -> runValidationT (f a))+ returnValidationT+ (>>=) =+ bindValidationT +_ValidationV' ::+ Validate f =>+ Iso (f e a) (f g b) (Validation' e a) (Validation' g b)+_ValidationV' =+ iso+ (\x -> ValidationT (Identity (x ^. _Validation)))+ (\(ValidationT (Identity x)) -> _Validation # x)+{-# INLINE _ValidationV' #-}++_AccValidationV ::+ Validate f =>+ Iso (f e a) (f g b) (AccValidation e a) (AccValidation g b)+_AccValidationV =+ iso+ (\x -> case x ^. _Validation of+ Failure e -> AccFailure e+ Success a -> AccSuccess a)+ (\x -> _Validation # case x of+ AccFailure e -> Failure e+ AccSuccess a -> Success a)+{-# INLINE _AccValidationV #-}++_EitherV ::+ Validate f =>+ Iso (f e a) (f g b) (Either e a) (Either g b)+_EitherV =+ 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 _EitherV #-}+ class Validate f where _Validation :: Iso (f e a) (f g b) (Validation e a) (Validation g b)+ _Validation' :: Iso (f e a) (f g b) (Validation' e a) (Validation' g b) _Validation' =- iso- (\x -> ValidationT (Identity (x ^. _Validation)))- (\(ValidationT (Identity x)) -> _Validation # x)+ _ValidationV'+ _AccValidation :: Iso (f e a) (f g b) (AccValidation e a) (AccValidation g b) _AccValidation =- iso- (\x -> case x ^. _Validation of- Failure e -> AccFailure e- Success a -> AccSuccess a)- (\x -> _Validation # case x of- AccFailure e -> Failure e- AccSuccess a -> Success a)+ _AccValidationV+ _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)+ _EitherV instance Validate Validation where _Validation =- iso- id- id+ id++_AccValidationValidationIso ::+ Iso (AccValidation e a) (AccValidation g b) (Validation e a) (Validation g b)+_AccValidationValidationIso =+ iso+ (\x -> case x of+ AccFailure e -> Failure e+ AccSuccess a -> Success a)+ (\x -> case x of+ Failure e -> AccFailure e+ Success a -> AccSuccess a)+{-# INLINE _AccValidationValidationIso #-}++_AccValidationEitherIso ::+ Iso (AccValidation e a) (AccValidation g b) (Either e a) (Either g b)+_AccValidationEitherIso =+ iso+ (\x -> case x of+ AccFailure e -> Left e+ AccSuccess a -> Right a)+ (\x -> case x of+ Left e -> AccFailure e+ Right a -> AccSuccess a)+{-# INLINE _AccValidationEitherIso #-}+ instance Validate AccValidation where _Validation =- iso- (\x -> case x of- AccFailure e -> Failure e- AccSuccess a -> Success a)- (\x -> case x of- Failure e -> AccFailure e- Success a -> AccSuccess a)+ _AccValidationValidationIso _AccValidation =- iso - id- id+ id+ _Either =+ _AccValidationEitherIso +_EitherValidationIso ::+ Iso (Either e a) (Either g b) (Validation e a) (Validation g b)+_EitherValidationIso =+ iso+ (\x -> case x of+ Left e -> Failure e+ Right a -> Success a)+ (\x -> case x of+ Failure e -> Left e+ Success a -> Right a)+{-# INLINE _EitherValidationIso #-}+ +_EitherAccValidationIso ::+ Iso (Either e a) (Either g b) (AccValidation e a) (AccValidation g b)+_EitherAccValidationIso =+ iso+ (\x -> case x of+ Left e -> AccFailure e+ Right a -> AccSuccess a)+ (\x -> case x of+ AccFailure e -> Left e+ AccSuccess a -> Right a)+{-# INLINE _EitherAccValidationIso #-}+ instance Validate Either where _Validation =- iso- (\x -> case x of- Left e -> Failure e- Right a -> Success a)- (\x -> case x of- Failure e -> Left e- Success a -> Right a)+ _EitherValidationIso+ _AccValidation =+ _EitherAccValidationIso _Either =- iso - id- id+ id _Failure :: Validate f =>@@ -409,6 +730,7 @@ (\x -> case x ^. _Either of Left e -> Right e Right a -> Left (_Either # Right a))+{-# INLINE _Failure #-} _Success :: Validate f =>@@ -419,29 +741,49 @@ (\x -> case x ^. _Either of Left e -> Left (_Either # Left e) Right a -> Right a)+{-# INLINE _Success #-} +swappedAccValidation ::+ Iso (AccValidation e a) (AccValidation f b) (AccValidation a e) (AccValidation b f)+swappedAccValidation =+ iso+ (\v -> case v of+ AccFailure e -> AccSuccess e+ AccSuccess a -> AccFailure a)+ (\v -> case v of+ AccFailure a -> AccSuccess a+ AccSuccess e -> AccFailure e)+{-# INLINE swappedAccValidation #-}++swappedValidation ::+ Iso (Validation e a) (Validation f b) (Validation a e) (Validation b f)+swappedValidation =+ 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 swappedValidation #-}++swappedValidationT ::+ Functor k =>+ Iso (ValidationT k e a) (ValidationT k f b) (ValidationT k a e) (ValidationT k b f)+swappedValidationT =+ iso+ (\(ValidationT x) -> ValidationT (fmap (swapped # ) x))+ (\(ValidationT x) -> ValidationT (fmap (swapped # ) x))+{-# INLINE swappedValidationT #-}+ instance Swapped AccValidation where swapped =- iso- (\v -> case v of- AccFailure e -> AccSuccess e- AccSuccess a -> AccFailure a)- (\v -> case v of- AccFailure a -> AccSuccess a- AccSuccess e -> AccFailure e)+ swappedAccValidation 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)+ swappedValidation instance Functor f => Swapped (ValidationT f) where swapped =- iso- (\(ValidationT x) -> ValidationT (fmap (swapped # ) x))- (\(ValidationT x) -> ValidationT (fmap (swapped # ) x))+ swappedValidationT
validation.cabal view
@@ -1,13 +1,16 @@ name: validation-version: 0.4.0+version: 0.4.1 license: BSD3 license-file: LICENSE-author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>, Nick Partridge-maintainer: Tony Morris, Nick Partridge-copyright: Tony Morris, Nick Partridge+author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart>+maintainer: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> <dibblego>, Nick Partridge <nkpart>+copyright: Copyright (C) 2014 NICTA Limited synopsis: A data-type like Either but with an accumulating Applicative category: Data-description: A data-type like Either but with an accumulating Applicative+description: + <<http://i.imgur.com/Ns5hntl.jpg>>+ .+ A data-type like Either but with an accumulating Applicative homepage: https://github.com/tonymorris/validation bug-reports: https://github.com/tonymorris/validation/issues cabal-version: >= 1.10@@ -26,7 +29,7 @@ Haskell2010 build-depends:- base < 5 && >= 3+ base < 5 && >= 3 , semigroups >= 0.8 , semigroupoids >= 4.0 , bifunctors >= 3.0@@ -56,11 +59,12 @@ Haskell2010 build-depends:- base < 5 && >= 3,- doctest >= 0.9.7,- filepath >= 1.3,- directory >= 1.1,- QuickCheck >= 2.0+ base < 5 && >= 3+ , doctest >= 0.9.7+ , filepath >= 1.3+ , directory >= 1.1+ , QuickCheck >= 2.0+ , template-haskell >= 2.8 ghc-options: -Wall