{-# 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
  ( Merge (Merge, runMerge)
  , merge
    -- * Construction
  , optional
  , required
  , combine
  , combineWith
  , combineGen
  , combineGenWith
  , Alternative(..)
  , Applicative(..)
    -- * Modification
  , flattenMaybe
  , Profunctor(..)
    -- * Useful Semigroups
  , Optional(..)
  , Required(..)
  , requiredToOptional
  , optionalToRequired
  , 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.Semigroup (Last (..), First (..), Product (..), Sum (..), Dual (..), Max (..), Min (..))

-- | 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 x a = Merge { Merge x a -> x -> x -> Maybe a
runMerge :: x -> x -> Maybe a }

-- | Flattens a 'Maybe' layer inside of a 'Merge'
flattenMaybe :: Merge x (Maybe a) -> Merge x a
flattenMaybe :: Merge x (Maybe a) -> Merge x a
flattenMaybe (Merge x -> x -> Maybe (Maybe a)
f) = (x -> x -> Maybe a) -> Merge x a
forall x a. (x -> x -> Maybe a) -> Merge x a
Merge \x
x x
x' -> Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (x -> x -> Maybe (Maybe a)
f x
x x
x')

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

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

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

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

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

instance Monad (Merge x) where
  Merge x a
a >>= :: Merge x a -> (a -> Merge x b) -> Merge x b
>>= a -> Merge x b
f = (x -> x -> Maybe b) -> Merge x b
forall x a. (x -> x -> Maybe a) -> Merge x a
Merge \x
x x
x' -> Maybe (Maybe b) -> Maybe b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe b) -> Maybe b) -> Maybe (Maybe b) -> Maybe b
forall a b. (a -> b) -> a -> b
$ (Merge x b -> Maybe b) -> Maybe (Merge x b) -> Maybe (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Merge x b
b -> Merge x b -> x -> x -> Maybe b
forall x a. Merge x a -> x -> x -> Maybe a
runMerge Merge x b
b x
x x
x') (Maybe (Merge x b) -> Maybe (Maybe b))
-> Maybe (Merge x b) -> Maybe (Maybe b)
forall a b. (a -> b) -> a -> b
$ (a -> Merge x b) -> Maybe a -> Maybe (Merge x b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Merge x b
f (Maybe a -> Maybe (Merge x b)) -> Maybe a -> Maybe (Merge x b)
forall a b. (a -> b) -> a -> b
$ Merge x a -> x -> x -> Maybe a
forall x a. Merge x a -> x -> x -> Maybe a
runMerge Merge x a
a x
x x
x'

instance Semigroup a => Semigroup (Merge x a) where
  Merge x a
a <> :: Merge x a -> Merge x a -> Merge x a
<> Merge x a
b = (x -> x -> Maybe a) -> Merge x a
forall x a. (x -> x -> Maybe a) -> Merge x a
Merge \x
x x
x' -> Merge x a -> x -> x -> Maybe a
forall x a. Merge x a -> x -> x -> Maybe a
runMerge Merge x a
a x
x x
x' Maybe a -> Maybe a -> Maybe a
forall a. Semigroup a => a -> a -> a
<> Merge x a -> x -> x -> Maybe a
forall x a. Merge x a -> x -> x -> Maybe a
runMerge Merge x a
b x
x x
x'

instance Semigroup a => Monoid (Merge x a) where
  mempty :: Merge x a
mempty = (x -> x -> Maybe a) -> Merge x a
forall x a. (x -> x -> Maybe a) -> Merge x a
Merge \x
_ x
_ -> Maybe a
forall a. Monoid a => a
mempty  

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

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

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

-- | Combine original fields of the record with the given function.
combineWith :: (a -> a -> a) -> (x -> a) -> Merge x a
combineWith :: (a -> a -> a) -> (x -> a) -> Merge x a
combineWith a -> a -> a
c x -> a
f = (x -> x -> Maybe a) -> Merge x a
forall x a. (x -> x -> Maybe a) -> Merge x a
Merge (\x
x x
x' -> a -> a -> Maybe a
go (x -> a
f x
x) (x -> a
f x
x')) where
  go :: a -> a -> Maybe a
go a
x a
x' = a -> Maybe a
forall a. a -> Maybe a
Just (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 s a x. (s -> s -> s) -> (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a
combineGenWith :: (s -> s -> s)
-> (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a
combineGenWith s -> s -> s
c a -> s
g s -> Maybe a
l x -> a
f = Merge x (Maybe a) -> Merge x a
forall x a. Merge x (Maybe a) -> Merge x a
flattenMaybe (Merge x (Maybe a) -> Merge x a) -> Merge x (Maybe a) -> Merge x a
forall a b. (a -> b) -> a -> b
$ (s -> Maybe a) -> Merge x s -> Merge x (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Maybe a
l (Merge x s -> Merge x (Maybe a)) -> Merge x s -> Merge x (Maybe a)
forall a b. (a -> b) -> a -> b
$ (s -> s -> s) -> (x -> s) -> Merge x s
forall a x. (a -> a -> a) -> (x -> a) -> Merge 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 :: Semigroup s => (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a
combineGen :: (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a
combineGen = (s -> s -> s)
-> (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge x a
forall s a x.
(s -> s -> s)
-> (a -> s) -> (s -> Maybe a) -> (x -> a) -> Merge 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 a = Required { Required a -> Maybe a
unRequired :: Maybe a }
  deriving (Required a -> Required a -> Bool
(Required a -> Required a -> Bool)
-> (Required a -> Required a -> Bool) -> Eq (Required a)
forall a. Eq a => Required a -> Required a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Required a -> Required a -> Bool
$c/= :: forall a. Eq a => Required a -> Required a -> Bool
== :: Required a -> Required a -> Bool
$c== :: forall a. Eq a => Required a -> Required a -> Bool
Eq, Int -> Required a -> ShowS
[Required a] -> ShowS
Required a -> String
(Int -> Required a -> ShowS)
-> (Required a -> String)
-> ([Required a] -> ShowS)
-> Show (Required a)
forall a. Show a => Int -> Required a -> ShowS
forall a. Show a => [Required a] -> ShowS
forall a. Show a => Required a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Required a] -> ShowS
$cshowList :: forall a. Show a => [Required a] -> ShowS
show :: Required a -> String
$cshow :: forall a. Show a => Required a -> String
showsPrec :: Int -> Required a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Required a -> ShowS
Show, ReadPrec [Required a]
ReadPrec (Required a)
Int -> ReadS (Required a)
ReadS [Required a]
(Int -> ReadS (Required a))
-> ReadS [Required a]
-> ReadPrec (Required a)
-> ReadPrec [Required a]
-> Read (Required a)
forall a. Read a => ReadPrec [Required a]
forall a. Read a => ReadPrec (Required a)
forall a. Read a => Int -> ReadS (Required a)
forall a. Read a => ReadS [Required a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Required a]
$creadListPrec :: forall a. Read a => ReadPrec [Required a]
readPrec :: ReadPrec (Required a)
$creadPrec :: forall a. Read a => ReadPrec (Required a)
readList :: ReadS [Required a]
$creadList :: forall a. Read a => ReadS [Required a]
readsPrec :: Int -> ReadS (Required a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Required a)
Read, Eq (Required a)
Eq (Required a)
-> (Required a -> Required a -> Ordering)
-> (Required a -> Required a -> Bool)
-> (Required a -> Required a -> Bool)
-> (Required a -> Required a -> Bool)
-> (Required a -> Required a -> Bool)
-> (Required a -> Required a -> Required a)
-> (Required a -> Required a -> Required a)
-> Ord (Required a)
Required a -> Required a -> Bool
Required a -> Required a -> Ordering
Required a -> Required a -> Required 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 a. Ord a => Eq (Required a)
forall a. Ord a => Required a -> Required a -> Bool
forall a. Ord a => Required a -> Required a -> Ordering
forall a. Ord a => Required a -> Required a -> Required a
min :: Required a -> Required a -> Required a
$cmin :: forall a. Ord a => Required a -> Required a -> Required a
max :: Required a -> Required a -> Required a
$cmax :: forall a. Ord a => Required a -> Required a -> Required a
>= :: Required a -> Required a -> Bool
$c>= :: forall a. Ord a => Required a -> Required a -> Bool
> :: Required a -> Required a -> Bool
$c> :: forall a. Ord a => Required a -> Required a -> Bool
<= :: Required a -> Required a -> Bool
$c<= :: forall a. Ord a => Required a -> Required a -> Bool
< :: Required a -> Required a -> Bool
$c< :: forall a. Ord a => Required a -> Required a -> Bool
compare :: Required a -> Required a -> Ordering
$ccompare :: forall a. Ord a => Required a -> Required a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Required a)
Ord, (forall x. Required a -> Rep (Required a) x)
-> (forall x. Rep (Required a) x -> Required a)
-> Generic (Required a)
forall x. Rep (Required a) x -> Required a
forall x. Required a -> Rep (Required a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Required a) x -> Required a
forall a x. Required a -> Rep (Required a) x
$cto :: forall a x. Rep (Required a) x -> Required a
$cfrom :: forall a x. Required a -> Rep (Required a) x
Generic, Typeable)

-- | We can convert any 'Required' to an 'Optional'
-- without losing any information.
requiredToOptional :: Required a -> Optional a
requiredToOptional :: Required a -> Optional a
requiredToOptional (Required Maybe a
ma) = Maybe (Maybe a) -> Optional a
forall a. Maybe (Maybe a) -> Optional a
Optional ((a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just Maybe a
ma)

instance Eq a => Semigroup (Required a) where
  Required (Just a
a) <> :: Required a -> Required a -> Required a
<> Required (Just a
a')
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' = Maybe a -> Required a
forall a. Maybe a -> Required a
Required (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
    | Bool
otherwise = Maybe a -> Required a
forall a. Maybe a -> Required a
Required Maybe a
forall a. Maybe a
Nothing
  Required Maybe a
_ <> Required Maybe a
_ = Maybe a -> Required a
forall a. Maybe a -> Required a
Required Maybe a
forall a. Maybe a
Nothing

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

-- | We can convert any 'Optional' to a 'Required',
-- entering the 'Required's inconsistent state if
-- the value is absent from the optional.
optionalToRequired :: Optional a -> Required a
optionalToRequired :: Optional a -> Required a
optionalToRequired = Maybe a -> Required a
forall a. Maybe a -> Required a
Required (Maybe a -> Required a)
-> (Optional a -> Maybe a) -> Optional a -> Required a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe a) -> Maybe a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe a) -> Maybe a)
-> (Optional a -> Maybe (Maybe a)) -> Optional a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optional a -> Maybe (Maybe a)
forall a. Optional a -> Maybe (Maybe a)
unOptional

instance Eq a => Semigroup (Optional a) where
  Optional (Just (Just a
a)) <> :: Optional a -> Optional a -> Optional a
<> Optional (Just (Just a
a'))
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' = Maybe (Maybe a) -> Optional a
forall a. Maybe (Maybe a) -> Optional a
Optional (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
    | Bool
otherwise = Maybe (Maybe a) -> Optional a
forall a. Maybe (Maybe a) -> Optional a
Optional Maybe (Maybe a)
forall a. Maybe a
Nothing
  Optional (Just Maybe a
Nothing) <> Optional a
x = Optional a
x
  Optional a
x <> Optional (Just Maybe a
Nothing) = Optional a
x
  Optional Maybe (Maybe a)
Nothing <> Optional a
x = Maybe (Maybe a) -> Optional a
forall a. Maybe (Maybe a) -> Optional a
Optional Maybe (Maybe a)
forall a. Maybe a
Nothing
  Optional a
x <> Optional Maybe (Maybe a)
Nothing = Maybe (Maybe a) -> Optional a
forall a. Maybe (Maybe a) -> Optional a
Optional Maybe (Maybe a)
forall a. Maybe a
Nothing

instance Eq a => Monoid (Optional a) where
  mempty :: Optional a
mempty = Maybe (Maybe a) -> Optional a
forall a. Maybe (Maybe a) -> Optional a
Optional (Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing)