diff --git a/changelog b/changelog index 734b211..37fec57 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +1.1.1 + +* Add `Eq1`, `Eq2`, `Ord1`, `Ord2`, `Show1`, `Show2`, `Read`, `Read1`, and `Read2` instances + 1.1 * Generalise types of `validate` and `ensure` functions to use `Maybe` instead of `Bool` diff --git a/src/Data/Validation.hs b/src/Data/Validation.hs index 7e19153..4310f4b 100644 --- a/src/Data/Validation.hs +++ b/src/Data/Validation.hs @@ -40,7 +40,13 @@ module Data.Validation , revalidate ) where -import Control.Applicative(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,23 +58,44 @@ 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((<.>))) +#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) #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (Generic) #endif -import Prelude(Show, Maybe(..)) - +import GHC.Read(Read(..)) +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@. @@ -84,7 +111,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 +212,48 @@ 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 (==) + +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 + +#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 = iso diff --git a/validation.cabal b/validation.cabal index cb20ad1..9966347 100644 --- a/validation.cabal +++ b/validation.cabal @@ -1,5 +1,5 @@ name: validation -version: 1.1 +version: 1.1.1 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ> , Nick Partridge