Validation re-write

validation.hs

data Validation e a
  = Failure e
  | Success a
  deriving (Eq, Ord, Show)

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

instance Semigroup e => Applicative (Validation e) where
  pure = Success
  Failure e <*> b = Failure $ case b of
                                Failure e' -> e <> e'
                                Success _  -> e
  Success _ <*> Failure e  = Failure e
  Success f <*> Success a = Success (f a)

instance (Semigroup e, Monoid e) => Alternative (Validation e) where
  empty = Failure mempty
  s@Success{} <|> _ = s
  _ <|> s@Success{} = s
  Failure e <|> Failure e' = Failure (e <> e')

instance Foldable (Validation e) where
  foldr f x (Success a) = f a x
  foldr _ x (Failure _) = x

instance Traversable (Validation e) 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)