-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Custom extension of 'Semigroup' to 'Monoid' that adds identity +
-- annihilator elements.
module Swarm.Util.Erasable where

-- | Extend a semigroup to a monoid by adding an identity ('ENothing') /and/ an
--   annihilator ('EErase').  That is,
--
--   * @ENothing <> e = e <> ENothing = e@
--   * @EErase <> e = e <> EErase = EErase@
--
--   This allows us to "erase" previous values by combining with
--   'EErase'.  The 'erasableToMaybe' function turns an 'Erasable'
--   into a 'Maybe' by collapsing 'ENothing' and 'EErase' both back
--   into 'Nothing'.
data Erasable e = ENothing | EErase | EJust e
  deriving (Int -> Erasable e -> ShowS
[Erasable e] -> ShowS
Erasable e -> String
(Int -> Erasable e -> ShowS)
-> (Erasable e -> String)
-> ([Erasable e] -> ShowS)
-> Show (Erasable e)
forall e. Show e => Int -> Erasable e -> ShowS
forall e. Show e => [Erasable e] -> ShowS
forall e. Show e => Erasable e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Erasable e -> ShowS
showsPrec :: Int -> Erasable e -> ShowS
$cshow :: forall e. Show e => Erasable e -> String
show :: Erasable e -> String
$cshowList :: forall e. Show e => [Erasable e] -> ShowS
showList :: [Erasable e] -> ShowS
Show, Erasable e -> Erasable e -> Bool
(Erasable e -> Erasable e -> Bool)
-> (Erasable e -> Erasable e -> Bool) -> Eq (Erasable e)
forall e. Eq e => Erasable e -> Erasable e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Erasable e -> Erasable e -> Bool
== :: Erasable e -> Erasable e -> Bool
$c/= :: forall e. Eq e => Erasable e -> Erasable e -> Bool
/= :: Erasable e -> Erasable e -> Bool
Eq, Eq (Erasable e)
Eq (Erasable e) =>
(Erasable e -> Erasable e -> Ordering)
-> (Erasable e -> Erasable e -> Bool)
-> (Erasable e -> Erasable e -> Bool)
-> (Erasable e -> Erasable e -> Bool)
-> (Erasable e -> Erasable e -> Bool)
-> (Erasable e -> Erasable e -> Erasable e)
-> (Erasable e -> Erasable e -> Erasable e)
-> Ord (Erasable e)
Erasable e -> Erasable e -> Bool
Erasable e -> Erasable e -> Ordering
Erasable e -> Erasable e -> Erasable e
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. Ord e => Eq (Erasable e)
forall e. Ord e => Erasable e -> Erasable e -> Bool
forall e. Ord e => Erasable e -> Erasable e -> Ordering
forall e. Ord e => Erasable e -> Erasable e -> Erasable e
$ccompare :: forall e. Ord e => Erasable e -> Erasable e -> Ordering
compare :: Erasable e -> Erasable e -> Ordering
$c< :: forall e. Ord e => Erasable e -> Erasable e -> Bool
< :: Erasable e -> Erasable e -> Bool
$c<= :: forall e. Ord e => Erasable e -> Erasable e -> Bool
<= :: Erasable e -> Erasable e -> Bool
$c> :: forall e. Ord e => Erasable e -> Erasable e -> Bool
> :: Erasable e -> Erasable e -> Bool
$c>= :: forall e. Ord e => Erasable e -> Erasable e -> Bool
>= :: Erasable e -> Erasable e -> Bool
$cmax :: forall e. Ord e => Erasable e -> Erasable e -> Erasable e
max :: Erasable e -> Erasable e -> Erasable e
$cmin :: forall e. Ord e => Erasable e -> Erasable e -> Erasable e
min :: Erasable e -> Erasable e -> Erasable e
Ord, (forall a b. (a -> b) -> Erasable a -> Erasable b)
-> (forall a b. a -> Erasable b -> Erasable a) -> Functor Erasable
forall a b. a -> Erasable b -> Erasable a
forall a b. (a -> b) -> Erasable a -> Erasable b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Erasable a -> Erasable b
fmap :: forall a b. (a -> b) -> Erasable a -> Erasable b
$c<$ :: forall a b. a -> Erasable b -> Erasable a
<$ :: forall a b. a -> Erasable b -> Erasable a
Functor)

instance Semigroup e => Semigroup (Erasable e) where
  Erasable e
ENothing <> :: Erasable e -> Erasable e -> Erasable e
<> Erasable e
e = Erasable e
e
  Erasable e
e <> Erasable e
ENothing = Erasable e
e
  Erasable e
EErase <> Erasable e
_ = Erasable e
forall e. Erasable e
EErase
  Erasable e
_ <> Erasable e
EErase = Erasable e
forall e. Erasable e
EErase
  EJust e
e1 <> EJust e
e2 = e -> Erasable e
forall e. e -> Erasable e
EJust (e
e1 e -> e -> e
forall a. Semigroup a => a -> a -> a
<> e
e2)

instance Semigroup e => Monoid (Erasable e) where
  mempty :: Erasable e
mempty = Erasable e
forall e. Erasable e
ENothing

-- | Generic eliminator for 'Erasable' values.
erasable :: a -> a -> (e -> a) -> Erasable e -> a
erasable :: forall a e. a -> a -> (e -> a) -> Erasable e -> a
erasable a
x a
y e -> a
z = \case
  Erasable e
ENothing -> a
x
  Erasable e
EErase -> a
y
  EJust e
e -> e -> a
z e
e

-- | Convert an 'Erasable' value to 'Maybe', turning both 'ENothing'
--   and 'EErase' into 'Nothing'.
erasableToMaybe :: Erasable e -> Maybe e
erasableToMaybe :: forall e. Erasable e -> Maybe e
erasableToMaybe = Maybe e -> Maybe e -> (e -> Maybe e) -> Erasable e -> Maybe e
forall a e. a -> a -> (e -> a) -> Erasable e -> a
erasable Maybe e
forall a. Maybe a
Nothing Maybe e
forall a. Maybe a
Nothing e -> Maybe e
forall a. a -> Maybe a
Just

-- | Inject a 'Maybe' value into 'Erasable' using 'ENothing' and
-- 'EJust'.
maybeToErasable :: Maybe e -> Erasable e
maybeToErasable :: forall e. Maybe e -> Erasable e
maybeToErasable = Erasable e -> (e -> Erasable e) -> Maybe e -> Erasable e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Erasable e
forall e. Erasable e
ENothing e -> Erasable e
forall e. e -> Erasable e
EJust