{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE RankNTypes #-}
{- |
Name: Data.Merge
Description: To describe merging of data types.
License: MIT
Copyright: Samuel Schlesinger 2021 (c)
-}
{-# LANGUAGE BlockArguments #-}
module Data.Merge
  ( 
    -- * A Validation Applicative
    Validation(..)
  , validation
    -- * The Merge type
  , Merge (Merge, runMerge)
    -- * Construction
  , (.?)
  , merge
  , optional
  , required
  , combine
  , combineWith
  , combineGen
  , combineGenWith
  , Alternative(..)
  , Applicative(..)
    -- * Modification
  , flattenValidation
  , Profunctor(..)
    -- * Useful Semigroups
  , Optional(..)
  , Required(..)
  , Last (..)
  , First (..)
  , Product (..)
  , Sum (..)
  , Dual (..)
  , Max (..)
  , Min (..)
  ) where

import GHC.Generics (Generic)
import Data.Typeable (Typeable)
import Control.Monad (join)
import Data.Coerce (Coercible, coerce)
import Control.Applicative (Alternative (..))
import Data.Profunctor (Profunctor (..))
import Data.Bifunctor (Bifunctor(..))
import Data.Semigroup (Last (..), First (..), Product (..), Sum (..), Dual (..), Max (..), Min (..))

-- | Like 'Either', but with an 'Applicative' instance which
-- accumulates errors using their 'Semigroup' operation.
data Validation e a =
    Error e
  | Success a
  deriving (a -> Validation e b -> Validation e a
(a -> b) -> Validation e a -> Validation e b
(forall a b. (a -> b) -> Validation e a -> Validation e b)
-> (forall a b. a -> Validation e b -> Validation e a)
-> Functor (Validation e)
forall a b. a -> Validation e b -> Validation e a
forall a b. (a -> b) -> Validation e a -> Validation e b
forall e a b. a -> Validation e b -> Validation e a
forall e a b. (a -> b) -> Validation e a -> Validation e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Validation e b -> Validation e a
$c<$ :: forall e a b. a -> Validation e b -> Validation e a
fmap :: (a -> b) -> Validation e a -> Validation e b
$cfmap :: forall e a b. (a -> b) -> Validation e a -> Validation e b
Functor, Validation e a -> Validation e a -> Bool
(Validation e a -> Validation e a -> Bool)
-> (Validation e a -> Validation e a -> Bool)
-> Eq (Validation e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a.
(Eq e, Eq a) =>
Validation e a -> Validation e a -> Bool
/= :: Validation e a -> Validation e a -> Bool
$c/= :: forall e a.
(Eq e, Eq a) =>
Validation e a -> Validation e a -> Bool
== :: Validation e a -> Validation e a -> Bool
$c== :: forall e a.
(Eq e, Eq a) =>
Validation e a -> Validation e a -> Bool
Eq, Eq (Validation e a)
Eq (Validation e a)
-> (Validation e a -> Validation e a -> Ordering)
-> (Validation e a -> Validation e a -> Bool)
-> (Validation e a -> Validation e a -> Bool)
-> (Validation e a -> Validation e a -> Bool)
-> (Validation e a -> Validation e a -> Bool)
-> (Validation e a -> Validation e a -> Validation e a)
-> (Validation e a -> Validation e a -> Validation e a)
-> Ord (Validation e a)
Validation e a -> Validation e a -> Bool
Validation e a -> Validation e a -> Ordering
Validation e a -> Validation e a -> Validation e a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e a. (Ord e, Ord a) => Eq (Validation e a)
forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Bool
forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Ordering
forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Validation e a
min :: Validation e a -> Validation e a -> Validation e a
$cmin :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Validation e a
max :: Validation e a -> Validation e a -> Validation e a
$cmax :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Validation e a
>= :: Validation e a -> Validation e a -> Bool
$c>= :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Bool
> :: Validation e a -> Validation e a -> Bool
$c> :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Bool
<= :: Validation e a -> Validation e a -> Bool
$c<= :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Bool
< :: Validation e a -> Validation e a -> Bool
$c< :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Bool
compare :: Validation e a -> Validation e a -> Ordering
$ccompare :: forall e a.
(Ord e, Ord a) =>
Validation e a -> Validation e a -> Ordering
$cp1Ord :: forall e a. (Ord e, Ord a) => Eq (Validation e a)
Ord, Int -> Validation e a -> ShowS
[Validation e a] -> ShowS
Validation e a -> String
(Int -> Validation e a -> ShowS)
-> (Validation e a -> String)
-> ([Validation e a] -> ShowS)
-> Show (Validation e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Validation e a -> ShowS
forall e a. (Show e, Show a) => [Validation e a] -> ShowS
forall e a. (Show e, Show a) => Validation e a -> String
showList :: [Validation e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Validation e a] -> ShowS
show :: Validation e a -> String
$cshow :: forall e a. (Show e, Show a) => Validation e a -> String
showsPrec :: Int -> Validation e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Validation e a -> ShowS
Show, ReadPrec [Validation e a]
ReadPrec (Validation e a)
Int -> ReadS (Validation e a)
ReadS [Validation e a]
(Int -> ReadS (Validation e a))
-> ReadS [Validation e a]
-> ReadPrec (Validation e a)
-> ReadPrec [Validation e a]
-> Read (Validation e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [Validation e a]
forall e a. (Read e, Read a) => ReadPrec (Validation e a)
forall e a. (Read e, Read a) => Int -> ReadS (Validation e a)
forall e a. (Read e, Read a) => ReadS [Validation e a]
readListPrec :: ReadPrec [Validation e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Validation e a]
readPrec :: ReadPrec (Validation e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Validation e a)
readList :: ReadS [Validation e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [Validation e a]
readsPrec :: Int -> ReadS (Validation e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Validation e a)
Read, (forall x. Validation e a -> Rep (Validation e a) x)
-> (forall x. Rep (Validation e a) x -> Validation e a)
-> Generic (Validation e a)
forall x. Rep (Validation e a) x -> Validation e a
forall x. Validation e a -> Rep (Validation e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Validation e a) x -> Validation e a
forall e a x. Validation e a -> Rep (Validation e a) x
$cto :: forall e a x. Rep (Validation e a) x -> Validation e a
$cfrom :: forall e a x. Validation e a -> Rep (Validation e a) x
Generic, Typeable)

validation :: (e -> r) -> (a -> r) -> Validation e a -> r
validation :: (e -> r) -> (a -> r) -> Validation e a -> r
validation e -> r
f a -> r
g = \case
  Error e
e -> e -> r
f e
e
  Success a
a -> a -> r
g a
a

instance Bifunctor Validation where
  bimap :: (a -> b) -> (c -> d) -> Validation a c -> Validation b d
bimap a -> b
f c -> d
g (Error a
e) = b -> Validation b d
forall e a. e -> Validation e a
Error (a -> b
f a
e)
  bimap a -> b
f c -> d
g (Success c
a) = d -> Validation b d
forall e a. a -> Validation e a
Success (c -> d
g c
a)

instance Semigroup e => Applicative (Validation e) where
  pure :: a -> Validation e a
pure = a -> Validation e a
forall e a. a -> Validation e a
Success
  Success a -> b
f <*> :: Validation e (a -> b) -> Validation e a -> Validation e b
<*> Success a
x = b -> Validation e b
forall e a. a -> Validation e a
Success (a -> b
f a
x)
  Error e
e   <*> Error e
e'  = e -> Validation e b
forall e a. e -> Validation e a
Error (e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e')
  Error e
e   <*> Validation e a
_         = e -> Validation e b
forall e a. e -> Validation e a
Error e
e
  Validation e (a -> b)
_         <*> Error e
e'  = e -> Validation e b
forall e a. e -> Validation e a
Error e
e'

instance Monoid e => Alternative (Validation e) where
  empty :: Validation e a
empty = e -> Validation e a
forall e a. e -> Validation e a
Error e
forall a. Monoid a => a
mempty
  Success a
a <|> :: Validation e a -> Validation e a -> Validation e a
<|> Validation e a
x = a -> Validation e a
forall e a. a -> Validation e a
Success a
a
  Error e
e <|> Validation e a
x = Validation e a
x

-- | Describes the merging of two values of the same type
-- into some other type. Represented as a 'Maybe' valued
-- function, one can also think of this as a predicate
-- showing which pairs of values can be merged in this way.
--
-- > data Example = Whatever { a :: Int, b :: Maybe Bool }
-- > mergeExamples :: Merge Example Example
-- > mergeExamples = Example <$> required a <*> optional b
newtype Merge e x a = Merge { Merge e x a -> x -> x -> Validation e a
runMerge :: x -> x -> Validation e a }

-- | Appends some errors. Useful for the combinators provided by this library,
-- which use 'mempty' to provide the default error type.
(.?) :: Semigroup e => Merge e x a -> e -> Merge e x a
Merge e x a
m .? :: Merge e x a -> e -> Merge e x a
.? e
e = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
x x
x' -> (e -> e) -> (a -> a) -> Validation e a -> Validation e a
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
<>) a -> a
forall a. a -> a
id (Merge e x a -> x -> x -> Validation e a
forall e x a. Merge e x a -> x -> x -> Validation e a
runMerge Merge e x a
m x
x x
x')

infixl 6 .?

-- | Flattens a 'Maybe' layer inside of a 'Merge'
flattenValidation :: Merge e x (Validation e a) -> Merge e x a
flattenValidation :: Merge e x (Validation e a) -> Merge e x a
flattenValidation (Merge x -> x -> Validation e (Validation e a)
f) = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
x x
x' ->
  case x -> x -> Validation e (Validation e a)
f x
x x
x' of
    Error e
e -> e -> Validation e a
forall e a. e -> Validation e a
Error e
e
    Success (Error e
e) -> e -> Validation e a
forall e a. e -> Validation e a
Error e
e
    Success (Success a
a) -> a -> Validation e a
forall e a. a -> Validation e a
Success a
a

-- | The most general combinator for constructing 'Merge's.
merge :: (x -> x -> Validation e a) -> Merge e x a
merge :: (x -> x -> Validation e a) -> Merge e x a
merge = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge

instance Profunctor (Merge e) where
  dimap :: (a -> b) -> (c -> d) -> Merge e b c -> Merge e a d
dimap a -> b
l c -> d
r (Merge b -> b -> Validation e c
f) = (a -> a -> Validation e d) -> Merge e a d
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \a
x a
x' -> c -> d
r (c -> d) -> Validation e c -> Validation e d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> b -> Validation e c
f (a -> b
l a
x) (a -> b
l a
x')

instance Functor (Merge e x) where
  fmap :: (a -> b) -> Merge e x a -> Merge e x b
fmap = (a -> b) -> Merge e x a -> Merge e x b
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap

instance Semigroup e => Applicative (Merge e x) where
  pure :: a -> Merge e x a
pure a
x = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge (\x
_ x
_ -> a -> Validation e a
forall e a. a -> Validation e a
Success a
x)
  Merge e x (a -> b)
fa <*> :: Merge e x (a -> b) -> Merge e x a -> Merge e x b
<*> Merge e x a
a = (x -> x -> Validation e b) -> Merge e x b
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
x x
x' -> Merge e x (a -> b) -> x -> x -> Validation e (a -> b)
forall e x a. Merge e x a -> x -> x -> Validation e a
runMerge Merge e x (a -> b)
fa x
x x
x' Validation e (a -> b) -> Validation e a -> Validation e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Merge e x a -> x -> x -> Validation e a
forall e x a. Merge e x a -> x -> x -> Validation e a
runMerge Merge e x a
a x
x x
x'

instance Monoid e => Alternative (Merge e x) where
  empty :: Merge e x a
empty = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
_ x
_ -> Validation e a
forall (f :: * -> *) a. Alternative f => f a
empty
  Merge x -> x -> Validation e a
f <|> :: Merge e x a -> Merge e x a -> Merge e x a
<|> Merge x -> x -> Validation e a
g = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
x x
x' -> x -> x -> Validation e a
f x
x x
x' Validation e a -> Validation e a -> Validation e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> x -> x -> Validation e a
g x
x x
x'

instance (Semigroup e, Semigroup a) => Semigroup (Merge e x a) where
  Merge e x a
a <> :: Merge e x a -> Merge e x a -> Merge e x a
<> Merge e x a
b = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
x x
x' -> a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (a -> a -> a) -> Validation e a -> Validation e (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Merge e x a -> x -> x -> Validation e a
forall e x a. Merge e x a -> x -> x -> Validation e a
runMerge Merge e x a
a x
x x
x' Validation e (a -> a) -> Validation e a -> Validation e a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Merge e x a -> x -> x -> Validation e a
forall e x a. Merge e x a -> x -> x -> Validation e a
runMerge Merge e x a
b x
x x
x'

instance (Monoid e, Semigroup a) => Monoid (Merge e x a) where
  mempty :: Merge e x a
mempty = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge \x
_ x
_ -> e -> Validation e a
forall e a. e -> Validation e a
Error e
forall a. Monoid a => a
mempty  

-- | Meant to be used to merge optional fields in a record.
optional :: (Monoid e, Eq a) => (x -> Maybe a) -> Merge e x (Maybe a)
optional :: (x -> Maybe a) -> Merge e x (Maybe a)
optional = (Maybe a -> Optional e a)
-> (Optional e a -> Validation e (Maybe a))
-> (x -> Maybe a)
-> Merge e x (Maybe a)
forall e a x s.
Semigroup s =>
(a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGen (Optional e a -> (a -> Optional e a) -> Maybe a -> Optional e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (Maybe a -> Validation e (Maybe a)
forall e a. a -> Validation e a
Success Maybe a
forall a. Maybe a
Nothing)) (Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (Validation e (Maybe a) -> Optional e a)
-> (a -> Validation e (Maybe a)) -> a -> Optional e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Validation e (Maybe a)
forall e a. a -> Validation e a
Success (Maybe a -> Validation e (Maybe a))
-> (a -> Maybe a) -> a -> Validation e (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)) Optional e a -> Validation e (Maybe a)
forall e a. Optional e a -> Validation e (Maybe a)
unOptional

-- | Meant to be used to merge required fields in a record.
required :: forall e a x. (Monoid e, Eq a) => (x -> a) -> Merge e x a
required :: (x -> a) -> Merge e x a
required = (a -> Required e a)
-> (Required e a -> Validation e a) -> (x -> a) -> Merge e x a
forall e a x s.
Semigroup s =>
(a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGen (Validation e a -> Required e a
forall e a. Validation e a -> Required e a
Required (Validation e a -> Required e a)
-> (a -> Validation e a) -> a -> Required e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Validation e a
forall e a. a -> Validation e a
Success) Required e a -> Validation e a
forall e a. Required e a -> Validation e a
unRequired

-- | Associatively combine original fields of the record.
combine :: forall e a x. Semigroup a => (x -> a) -> Merge e x a
combine :: (x -> a) -> Merge e x a
combine = (a -> a -> a) -> (x -> a) -> Merge e x a
forall e a x. (a -> a -> a) -> (x -> a) -> Merge e x a
combineWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Combine original fields of the record with the given function.
combineWith :: forall e a x. (a -> a -> a) -> (x -> a) -> Merge e x a
combineWith :: (a -> a -> a) -> (x -> a) -> Merge e x a
combineWith a -> a -> a
c x -> a
f = (x -> x -> Validation e a) -> Merge e x a
forall e x a. (x -> x -> Validation e a) -> Merge e x a
Merge (\x
x x
x' -> a -> a -> Validation e a
forall e. a -> a -> Validation e a
go (x -> a
f x
x) (x -> a
f x
x')) where
  go :: a -> a -> Validation e a
go a
x a
x' = a -> Validation e a
forall e a. a -> Validation e a
Success (a
x a -> a -> a
`c` a
x')

-- | Sometimes, one can describe a merge strategy via a binary operator. 'Optional'
-- and 'Required' describe 'optional' and 'required', respectively, in this way.
combineGenWith :: forall e a x s. (s -> s -> s) -> (a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGenWith :: (s -> s -> s)
-> (a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGenWith s -> s -> s
c a -> s
g s -> Validation e a
l x -> a
f = Merge e x (Validation e a) -> Merge e x a
forall e x a. Merge e x (Validation e a) -> Merge e x a
flattenValidation (Merge e x (Validation e a) -> Merge e x a)
-> Merge e x (Validation e a) -> Merge e x a
forall a b. (a -> b) -> a -> b
$ (s -> Validation e a) -> Merge e x s -> Merge e x (Validation e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Validation e a
l (Merge e x s -> Merge e x (Validation e a))
-> Merge e x s -> Merge e x (Validation e a)
forall a b. (a -> b) -> a -> b
$ (s -> s -> s) -> (x -> s) -> Merge e x s
forall e a x. (a -> a -> a) -> (x -> a) -> Merge e x a
combineWith s -> s -> s
c (a -> s
g (a -> s) -> (x -> a) -> x -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a
f)

-- | 'combineGen' specialized to 'Semigroup' operations.
combineGen :: forall e a x s. Semigroup s => (a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGen :: (a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGen = (s -> s -> s)
-> (a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
forall e a x s.
(s -> s -> s)
-> (a -> s) -> (s -> Validation e a) -> (x -> a) -> Merge e x a
combineGenWith s -> s -> s
forall a. Semigroup a => a -> a -> a
(<>)

-- | This type's 'Semigroup' instance encodes the simple,
-- discrete lattice generated by any given set, excluding the
-- bottom.
newtype Required e a = Required { Required e a -> Validation e a
unRequired :: Validation e a }
  deriving (Required e a -> Required e a -> Bool
(Required e a -> Required e a -> Bool)
-> (Required e a -> Required e a -> Bool) -> Eq (Required e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Required e a -> Required e a -> Bool
/= :: Required e a -> Required e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Required e a -> Required e a -> Bool
== :: Required e a -> Required e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Required e a -> Required e a -> Bool
Eq, Int -> Required e a -> ShowS
[Required e a] -> ShowS
Required e a -> String
(Int -> Required e a -> ShowS)
-> (Required e a -> String)
-> ([Required e a] -> ShowS)
-> Show (Required e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Required e a -> ShowS
forall e a. (Show e, Show a) => [Required e a] -> ShowS
forall e a. (Show e, Show a) => Required e a -> String
showList :: [Required e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Required e a] -> ShowS
show :: Required e a -> String
$cshow :: forall e a. (Show e, Show a) => Required e a -> String
showsPrec :: Int -> Required e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Required e a -> ShowS
Show, ReadPrec [Required e a]
ReadPrec (Required e a)
Int -> ReadS (Required e a)
ReadS [Required e a]
(Int -> ReadS (Required e a))
-> ReadS [Required e a]
-> ReadPrec (Required e a)
-> ReadPrec [Required e a]
-> Read (Required e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [Required e a]
forall e a. (Read e, Read a) => ReadPrec (Required e a)
forall e a. (Read e, Read a) => Int -> ReadS (Required e a)
forall e a. (Read e, Read a) => ReadS [Required e a]
readListPrec :: ReadPrec [Required e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Required e a]
readPrec :: ReadPrec (Required e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Required e a)
readList :: ReadS [Required e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [Required e a]
readsPrec :: Int -> ReadS (Required e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Required e a)
Read, Eq (Required e a)
Eq (Required e a)
-> (Required e a -> Required e a -> Ordering)
-> (Required e a -> Required e a -> Bool)
-> (Required e a -> Required e a -> Bool)
-> (Required e a -> Required e a -> Bool)
-> (Required e a -> Required e a -> Bool)
-> (Required e a -> Required e a -> Required e a)
-> (Required e a -> Required e a -> Required e a)
-> Ord (Required e a)
Required e a -> Required e a -> Bool
Required e a -> Required e a -> Ordering
Required e a -> Required e a -> Required e a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e a. (Ord e, Ord a) => Eq (Required e a)
forall e a. (Ord e, Ord a) => Required e a -> Required e a -> Bool
forall e a.
(Ord e, Ord a) =>
Required e a -> Required e a -> Ordering
forall e a.
(Ord e, Ord a) =>
Required e a -> Required e a -> Required e a
min :: Required e a -> Required e a -> Required e a
$cmin :: forall e a.
(Ord e, Ord a) =>
Required e a -> Required e a -> Required e a
max :: Required e a -> Required e a -> Required e a
$cmax :: forall e a.
(Ord e, Ord a) =>
Required e a -> Required e a -> Required e a
>= :: Required e a -> Required e a -> Bool
$c>= :: forall e a. (Ord e, Ord a) => Required e a -> Required e a -> Bool
> :: Required e a -> Required e a -> Bool
$c> :: forall e a. (Ord e, Ord a) => Required e a -> Required e a -> Bool
<= :: Required e a -> Required e a -> Bool
$c<= :: forall e a. (Ord e, Ord a) => Required e a -> Required e a -> Bool
< :: Required e a -> Required e a -> Bool
$c< :: forall e a. (Ord e, Ord a) => Required e a -> Required e a -> Bool
compare :: Required e a -> Required e a -> Ordering
$ccompare :: forall e a.
(Ord e, Ord a) =>
Required e a -> Required e a -> Ordering
$cp1Ord :: forall e a. (Ord e, Ord a) => Eq (Required e a)
Ord, (forall x. Required e a -> Rep (Required e a) x)
-> (forall x. Rep (Required e a) x -> Required e a)
-> Generic (Required e a)
forall x. Rep (Required e a) x -> Required e a
forall x. Required e a -> Rep (Required e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Required e a) x -> Required e a
forall e a x. Required e a -> Rep (Required e a) x
$cto :: forall e a x. Rep (Required e a) x -> Required e a
$cfrom :: forall e a x. Required e a -> Rep (Required e a) x
Generic, Typeable)

instance (Monoid e, Eq a) => Semigroup (Required e a) where
  Required (Success a
a) <> :: Required e a -> Required e a -> Required e a
<> Required (Success a
a')
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' = Validation e a -> Required e a
forall e a. Validation e a -> Required e a
Required (a -> Validation e a
forall e a. a -> Validation e a
Success a
a)
    | Bool
otherwise = Validation e a -> Required e a
forall e a. Validation e a -> Required e a
Required (e -> Validation e a
forall e a. e -> Validation e a
Error e
forall a. Monoid a => a
mempty)
  Required (Error e
e) <> Required (Success a
_) = Validation e a -> Required e a
forall e a. Validation e a -> Required e a
Required (e -> Validation e a
forall e a. e -> Validation e a
Error e
e)
  Required (Success a
_) <> Required (Error e
e') = Validation e a -> Required e a
forall e a. Validation e a -> Required e a
Required (e -> Validation e a
forall e a. e -> Validation e a
Error e
e')
  Required (Error e
e) <> Required (Error e
e') = Validation e a -> Required e a
forall e a. Validation e a -> Required e a
Required (e -> Validation e a
forall e a. e -> Validation e a
Error (e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e'))

-- | This type's 'Semigroup' instance encodes the simple,
-- deiscrete lattice generated by any given set.
newtype Optional e a = Optional { Optional e a -> Validation e (Maybe a)
unOptional :: Validation e (Maybe a) }
  deriving (Optional e a -> Optional e a -> Bool
(Optional e a -> Optional e a -> Bool)
-> (Optional e a -> Optional e a -> Bool) -> Eq (Optional e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a. (Eq e, Eq a) => Optional e a -> Optional e a -> Bool
/= :: Optional e a -> Optional e a -> Bool
$c/= :: forall e a. (Eq e, Eq a) => Optional e a -> Optional e a -> Bool
== :: Optional e a -> Optional e a -> Bool
$c== :: forall e a. (Eq e, Eq a) => Optional e a -> Optional e a -> Bool
Eq, Int -> Optional e a -> ShowS
[Optional e a] -> ShowS
Optional e a -> String
(Int -> Optional e a -> ShowS)
-> (Optional e a -> String)
-> ([Optional e a] -> ShowS)
-> Show (Optional e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Optional e a -> ShowS
forall e a. (Show e, Show a) => [Optional e a] -> ShowS
forall e a. (Show e, Show a) => Optional e a -> String
showList :: [Optional e a] -> ShowS
$cshowList :: forall e a. (Show e, Show a) => [Optional e a] -> ShowS
show :: Optional e a -> String
$cshow :: forall e a. (Show e, Show a) => Optional e a -> String
showsPrec :: Int -> Optional e a -> ShowS
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Optional e a -> ShowS
Show, ReadPrec [Optional e a]
ReadPrec (Optional e a)
Int -> ReadS (Optional e a)
ReadS [Optional e a]
(Int -> ReadS (Optional e a))
-> ReadS [Optional e a]
-> ReadPrec (Optional e a)
-> ReadPrec [Optional e a]
-> Read (Optional e a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall e a. (Read e, Read a) => ReadPrec [Optional e a]
forall e a. (Read e, Read a) => ReadPrec (Optional e a)
forall e a. (Read e, Read a) => Int -> ReadS (Optional e a)
forall e a. (Read e, Read a) => ReadS [Optional e a]
readListPrec :: ReadPrec [Optional e a]
$creadListPrec :: forall e a. (Read e, Read a) => ReadPrec [Optional e a]
readPrec :: ReadPrec (Optional e a)
$creadPrec :: forall e a. (Read e, Read a) => ReadPrec (Optional e a)
readList :: ReadS [Optional e a]
$creadList :: forall e a. (Read e, Read a) => ReadS [Optional e a]
readsPrec :: Int -> ReadS (Optional e a)
$creadsPrec :: forall e a. (Read e, Read a) => Int -> ReadS (Optional e a)
Read, Eq (Optional e a)
Eq (Optional e a)
-> (Optional e a -> Optional e a -> Ordering)
-> (Optional e a -> Optional e a -> Bool)
-> (Optional e a -> Optional e a -> Bool)
-> (Optional e a -> Optional e a -> Bool)
-> (Optional e a -> Optional e a -> Bool)
-> (Optional e a -> Optional e a -> Optional e a)
-> (Optional e a -> Optional e a -> Optional e a)
-> Ord (Optional e a)
Optional e a -> Optional e a -> Bool
Optional e a -> Optional e a -> Ordering
Optional e a -> Optional e a -> Optional e a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall e a. (Ord e, Ord a) => Eq (Optional e a)
forall e a. (Ord e, Ord a) => Optional e a -> Optional e a -> Bool
forall e a.
(Ord e, Ord a) =>
Optional e a -> Optional e a -> Ordering
forall e a.
(Ord e, Ord a) =>
Optional e a -> Optional e a -> Optional e a
min :: Optional e a -> Optional e a -> Optional e a
$cmin :: forall e a.
(Ord e, Ord a) =>
Optional e a -> Optional e a -> Optional e a
max :: Optional e a -> Optional e a -> Optional e a
$cmax :: forall e a.
(Ord e, Ord a) =>
Optional e a -> Optional e a -> Optional e a
>= :: Optional e a -> Optional e a -> Bool
$c>= :: forall e a. (Ord e, Ord a) => Optional e a -> Optional e a -> Bool
> :: Optional e a -> Optional e a -> Bool
$c> :: forall e a. (Ord e, Ord a) => Optional e a -> Optional e a -> Bool
<= :: Optional e a -> Optional e a -> Bool
$c<= :: forall e a. (Ord e, Ord a) => Optional e a -> Optional e a -> Bool
< :: Optional e a -> Optional e a -> Bool
$c< :: forall e a. (Ord e, Ord a) => Optional e a -> Optional e a -> Bool
compare :: Optional e a -> Optional e a -> Ordering
$ccompare :: forall e a.
(Ord e, Ord a) =>
Optional e a -> Optional e a -> Ordering
$cp1Ord :: forall e a. (Ord e, Ord a) => Eq (Optional e a)
Ord, (forall x. Optional e a -> Rep (Optional e a) x)
-> (forall x. Rep (Optional e a) x -> Optional e a)
-> Generic (Optional e a)
forall x. Rep (Optional e a) x -> Optional e a
forall x. Optional e a -> Rep (Optional e a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e a x. Rep (Optional e a) x -> Optional e a
forall e a x. Optional e a -> Rep (Optional e a) x
$cto :: forall e a x. Rep (Optional e a) x -> Optional e a
$cfrom :: forall e a x. Optional e a -> Rep (Optional e a) x
Generic, Typeable)

instance (Monoid e, Eq a) => Semigroup (Optional e a) where
  Optional (Success (Just a
a)) <> :: Optional e a -> Optional e a -> Optional e a
<> Optional (Success (Just a
a'))
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' = Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (Maybe a -> Validation e (Maybe a)
forall e a. a -> Validation e a
Success (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
    | Bool
otherwise = Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (e -> Validation e (Maybe a)
forall e a. e -> Validation e a
Error e
forall a. Monoid a => a
mempty)
  Optional (Success Maybe a
Nothing) <> Optional e a
x = Optional e a
x
  Optional e a
x <> Optional (Success Maybe a
Nothing) = Optional e a
x
  Optional (Error e
e) <> Optional (Error e
e') = Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (e -> Validation e (Maybe a)
forall e a. e -> Validation e a
Error (e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e'))
  Optional e a
x <> Optional (Error e
e) = Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (e -> Validation e (Maybe a)
forall e a. e -> Validation e a
Error e
e)
  Optional (Error e
e) <> Optional e a
x = Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (e -> Validation e (Maybe a)
forall e a. e -> Validation e a
Error e
e)

instance (Monoid e, Eq a) => Monoid (Optional e a) where
  mempty :: Optional e a
mempty = Validation e (Maybe a) -> Optional e a
forall e a. Validation e (Maybe a) -> Optional e a
Optional (Maybe a -> Validation e (Maybe a)
forall e a. a -> Validation e a
Success Maybe a
forall a. Maybe a
Nothing)