-- | A simple data structure helping us ask questions of the following
-- sort: "does all this data have the same /BLANK/ and if so what is
-- it?"
--
-- For example:
--
-- > doTheseHaveTheSameLength :: [String] -> String
-- > doTheseHaveTheSameLength l = case foldMap (Somebody . length) of
-- >   Somebody n -> "They all have length " <> show n
-- >   Nobody     -> "The lengths differ"
-- >   Anybody    -> "You didn't give me any strings"
module Data.Agreement (
  Agreement(..),
  getSomebody,
  ) where

import Data.Semigroup (Semigroup(..),
                       stimesIdempotentMonoid)

-- | We have the following constructors:
--
--   * `Somebody` is a consistent choice of an element.
--
--   * `Nobody` is an inconsistent choice.
--
--   * `Anybody` is a failure to make any choice.
data Agreement a = Anybody | Somebody a | Nobody

-- | This picks out consistent choices as `Just`.
getSomebody :: Agreement a -> Maybe a
getSomebody :: forall a. Agreement a -> Maybe a
getSomebody (Somebody a
x) = forall a. a -> Maybe a
Just a
x
getSomebody Agreement a
_ = forall a. Maybe a
Nothing

instance Functor Agreement where
  fmap :: forall a b. (a -> b) -> Agreement a -> Agreement b
fmap a -> b
_ Agreement a
Anybody = forall a. Agreement a
Anybody
  fmap a -> b
f (Somebody a
x) = forall a. a -> Agreement a
Somebody (a -> b
f a
x)
  fmap a -> b
_ Agreement a
Nobody = forall a. Agreement a
Nobody

instance (Eq a) => Semigroup (Agreement a) where
  Agreement a
Anybody <> :: Agreement a -> Agreement a -> Agreement a
<> Agreement a
x = Agreement a
x
  Agreement a
Nobody <> Agreement a
_ = forall a. Agreement a
Nobody
  Somebody a
x <> Agreement a
Anybody = forall a. a -> Agreement a
Somebody a
x
  Somebody a
_ <> Agreement a
Nobody = forall a. Agreement a
Nobody
  Somebody a
x <> Somebody a
y
    | a
x forall a. Eq a => a -> a -> Bool
== a
y = forall a. a -> Agreement a
Somebody a
x
    | Bool
otherwise = forall a. Agreement a
Nobody
  stimes :: forall b. Integral b => b -> Agreement a -> Agreement a
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid

instance (Eq a) => Monoid (Agreement a) where
  mempty :: Agreement a
mempty = forall a. Agreement a
Anybody