From f9ff5bd89852c990150542f5b5cf1e0cb1c0bcf2 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Fri, 19 Apr 2019 10:44:47 -0400 Subject: [PATCH 1/2] Adding useful instances from base. --- changelog | 4 ++++ src/Data/Validation.hs | 44 +++++++++++++++++++++++++++++++++++++----- validation.cabal | 2 +- 3 files changed, 44 insertions(+), 6 deletions(-) diff --git a/changelog b/changelog index d3b3283..9935bf9 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +1.0.1 + +* Add `Eq1`, `Eq2`, `Ord1`, `Ord2`, `Show1`, `Show2`, `Read`, `Read1`, and `Read2` instances + 1 * Rename `AccValidation` to `Validation` diff --git a/src/Data/Validation.hs b/src/Data/Validation.hs index 7e19153..15e0834 100644 --- a/src/Data/Validation.hs +++ b/src/Data/Validation.hs @@ -40,7 +40,7 @@ module Data.Validation , revalidate ) where -import Control.Applicative(Applicative((<*>), pure), (<$>)) +import Control.Applicative(Alternative((<|>)), Applicative((<*>), pure), (<$>)) import Control.DeepSeq (NFData (rnf)) import Control.Lens (over, under) import Control.Lens.Getter((^.)) @@ -52,22 +52,24 @@ 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.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.Functor.Classes(Eq1 (..), Eq2(..), Ord1 (..), Ord2(..), Show1 (..), Show2(..), Read1(..), Read2(..), showsUnaryWith, readData, readUnaryWith) import Data.List.NonEmpty (NonEmpty) import Data.Monoid(Monoid(mappend, mempty)) -import Data.Ord(Ord) +import Data.Ord(Ord(compare), Ordering(GT,LT)) import Data.Semigroup(Semigroup((<>))) import Data.Traversable(Traversable(traverse)) import Data.Typeable(Typeable) #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) #endif -import Prelude(Show, Maybe(..)) +import GHC.Read(Read(..)) +import Prelude(Bool(False), Show(..), Maybe(..)) -- | An @Validation@ is either a value of the type @err@ or @a@, similar to 'Either'. However, @@ -84,7 +86,7 @@ data Validation err a = Failure err | Success a deriving ( - Eq, Ord, Show, Data, Typeable + Eq, Ord, Show, Read, Data, Typeable #if __GLASGOW_HASKELL__ >= 702 , Generic #endif @@ -185,6 +187,38 @@ instance Monoid e => Monoid (Validation e a) where Failure mempty {-# INLINE mempty #-} +instance Eq e => Eq1 (Validation e) where + liftEq = liftEq2 (==) + +instance Eq2 Validation where + liftEq2 e _ (Failure x) (Failure y) = e x y + liftEq2 _ e (Success x) (Success y) = e x y + liftEq2 _ _ _ _ = False + +instance Ord e => Ord1 (Validation e) where + liftCompare = liftCompare2 compare + +instance Ord2 Validation where + liftCompare2 c _ (Failure x) (Failure y) = c x y + liftCompare2 _ _ (Failure _) (Success _) = LT + liftCompare2 _ _ (Success _) (Failure _) = GT + liftCompare2 _ c (Success x) (Success y) = c x y + +instance Show e => Show1 (Validation e) where + liftShowsPrec = liftShowsPrec2 showsPrec showList + +instance Show2 Validation where + liftShowsPrec2 sp1 _ _ _ d (Failure x) = showsUnaryWith sp1 "Failure" d x + liftShowsPrec2 _ _ sp2 _ d (Success x) = showsUnaryWith sp2 "Success" d x + +instance Read e => Read1 (Validation e) where + liftReadPrec = liftReadPrec2 readPrec readListPrec + +instance Read2 Validation where + liftReadPrec2 rp1 _ rp2 _ = readData $ + readUnaryWith rp1 "Failure" Failure <|> + readUnaryWith rp2 "Success" Success + instance Swapped Validation where swapped = iso diff --git a/validation.cabal b/validation.cabal index 7af3c1f..a904351 100644 --- a/validation.cabal +++ b/validation.cabal @@ -1,5 +1,5 @@ name: validation -version: 1 +version: 1.0.1 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> , Nick Partridge From 81451e3a764fb8758ab2426f12ae51a08aa18225 Mon Sep 17 00:00:00 2001 From: Alex Washburn Date: Mon, 22 Apr 2019 09:32:27 -0400 Subject: [PATCH 2/2] Adding CPP guards for backwards compatibility. --- src/Data/Validation.hs | 43 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 39 insertions(+), 4 deletions(-) diff --git a/src/Data/Validation.hs b/src/Data/Validation.hs index 15e0834..4310f4b 100644 --- a/src/Data/Validation.hs +++ b/src/Data/Validation.hs @@ -40,7 +40,13 @@ module Data.Validation , revalidate ) where -import Control.Applicative(Alternative((<|>)), Applicative((<*>), pure), (<$>)) +import Control.Applicative(Applicative((<*>), pure), (<$>), +#if __GLASGOW_HASKELL__ >= 821 + Alternative((<|>)) +#else +-- Alternative() +#endif + ) import Control.DeepSeq (NFData (rnf)) import Control.Lens (over, under) import Control.Lens.Getter((^.)) @@ -52,16 +58,32 @@ import Data.Bifunctor(Bifunctor(bimap)) import Data.Bitraversable(Bitraversable(bitraverse)) import Data.Data(Data) import Data.Either(Either(Left, Right), either) +#if __GLASGOW_HASKELL__ >= 801 import Data.Eq(Eq((==))) +#else +import Data.Eq(Eq) +#endif 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.Functor.Classes(Eq1 (..), Eq2(..), Ord1 (..), Ord2(..), Show1 (..), Show2(..), Read1(..), Read2(..), showsUnaryWith, readData, readUnaryWith) +#if __GLASGOW_HASKELL__ >= 801 +import Data.Functor.Classes(Eq1 (..), Eq2(..), Ord1 (..), Ord2(..), Show1 (..), Show2(..), Read1(..), Read2(..), showsUnaryWith +#if __GLASGOW_HASKELL__ >= 821 + , readData, readUnaryWith +#else + , readsData, readsUnaryWith +#endif + ) +#endif import Data.List.NonEmpty (NonEmpty) import Data.Monoid(Monoid(mappend, mempty)) +#if __GLASGOW_HASKELL__ >= 801 import Data.Ord(Ord(compare), Ordering(GT,LT)) +#else +import Data.Ord(Ord) +#endif import Data.Semigroup(Semigroup((<>))) import Data.Traversable(Traversable(traverse)) import Data.Typeable(Typeable) @@ -69,8 +91,11 @@ import Data.Typeable(Typeable) import GHC.Generics (Generic) #endif import GHC.Read(Read(..)) -import Prelude(Bool(False), Show(..), Maybe(..)) - +import Prelude(Show(..), Maybe(..) +#if __GLASGOW_HASKELL__ >= 801 + , Bool(False) +#endif + ) -- | 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@. @@ -187,6 +212,7 @@ instance Monoid e => Monoid (Validation e a) where Failure mempty {-# INLINE mempty #-} +#if __GLASGOW_HASKELL__ >= 801 instance Eq e => Eq1 (Validation e) where liftEq = liftEq2 (==) @@ -215,9 +241,18 @@ instance Read e => Read1 (Validation e) where liftReadPrec = liftReadPrec2 readPrec readListPrec instance Read2 Validation where + +#if __GLASGOW_HASKELL__ >= 821 liftReadPrec2 rp1 _ rp2 _ = readData $ readUnaryWith rp1 "Failure" Failure <|> readUnaryWith rp2 "Success" Success +#else + liftReadsPrec2 rp1 _ rp2 _ = readsData $ + readsUnaryWith rp1 "Failure" Failure `mappend` + readsUnaryWith rp2 "Success" Success + +#endif +#endif instance Swapped Validation where swapped =