-- |
-- 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
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
showList :: [Erasable e] -> ShowS
$cshowList :: forall e. Show e => [Erasable e] -> ShowS
show :: Erasable e -> String
$cshow :: forall e. Show e => Erasable e -> String
showsPrec :: Int -> Erasable e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Erasable e -> ShowS
Show, Erasable e -> Erasable e -> Bool
forall e. Eq e => Erasable e -> Erasable e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Erasable e -> Erasable e -> Bool
$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
Eq, Erasable e -> Erasable e -> Bool
Erasable e -> Erasable e -> Ordering
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
min :: Erasable e -> Erasable e -> Erasable e
$cmin :: forall e. Ord e => Erasable e -> Erasable e -> Erasable e
max :: Erasable e -> Erasable e -> Erasable e
$cmax :: forall e. Ord e => Erasable e -> Erasable e -> Erasable e
>= :: 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
$c< :: forall e. Ord e => Erasable e -> Erasable e -> Bool
compare :: Erasable e -> Erasable e -> Ordering
$ccompare :: forall e. Ord e => Erasable e -> Erasable e -> Ordering
Ord, 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
<$ :: forall a b. a -> Erasable b -> Erasable a
$c<$ :: forall a b. a -> Erasable b -> Erasable a
fmap :: forall a b. (a -> b) -> Erasable a -> Erasable b
$cfmap :: forall a b. (a -> b) -> Erasable a -> Erasable b
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
_ = forall e. Erasable e
EErase
  Erasable e
_ <> Erasable e
EErase = forall e. Erasable e
EErase
  EJust e
e1 <> EJust e
e2 = forall e. e -> Erasable e
EJust (e
e1 forall a. Semigroup a => a -> a -> a
<> e
e2)

instance Semigroup e => Monoid (Erasable e) where
  mempty :: Erasable e
mempty = 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 = forall a e. a -> a -> (e -> a) -> Erasable e -> a
erasable forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall e. Erasable e
ENothing forall e. e -> Erasable e
EJust