{-# LANGUAGE CPP #-}

-- | 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"
--
-- This can of course be done with `Maybe (Maybe x)` instead, but
-- doing so runs the risk of getting confused: which is `Nothing` and
-- which is `Just Nothing`?
--
-- Unfortunately, there are two `Applicative` instances.
--
-- One is easy to motivate intrinsically. If we think of `Anybody` as
-- an empty list, `Somebody` as a singleton list, and `Nobody` as a
-- multi-element list, and think of the applicative instance on as
-- corresponding to the cartesian product, then we get an
-- `Applicative` instance with
--
-- > Anybody <*> Anybody = Anybody
-- > Anybody <*> Nobody = Nobody
--
-- This however cannot possibly correspond to a `Monad` instance (if
-- the first argument of `>>=` is Anybody, there's no way of
-- inspecting the second). We thus choose another, which does.
module Data.Agreement (
  Agreement(..),
  getSomebody,
  ) where

#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)
#else
import Control.Applicative (liftA2)
#endif

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
  deriving (Agreement a -> Agreement a -> Bool
forall a. Eq a => Agreement a -> Agreement a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Agreement a -> Agreement a -> Bool
$c/= :: forall a. Eq a => Agreement a -> Agreement a -> Bool
== :: Agreement a -> Agreement a -> Bool
$c== :: forall a. Eq a => Agreement a -> Agreement a -> Bool
Eq, Agreement a -> Agreement a -> Bool
Agreement a -> Agreement a -> 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 {a}. Ord a => Eq (Agreement a)
forall a. Ord a => Agreement a -> Agreement a -> Bool
forall a. Ord a => Agreement a -> Agreement a -> Ordering
forall a. Ord a => Agreement a -> Agreement a -> Agreement a
min :: Agreement a -> Agreement a -> Agreement a
$cmin :: forall a. Ord a => Agreement a -> Agreement a -> Agreement a
max :: Agreement a -> Agreement a -> Agreement a
$cmax :: forall a. Ord a => Agreement a -> Agreement a -> Agreement a
>= :: Agreement a -> Agreement a -> Bool
$c>= :: forall a. Ord a => Agreement a -> Agreement a -> Bool
> :: Agreement a -> Agreement a -> Bool
$c> :: forall a. Ord a => Agreement a -> Agreement a -> Bool
<= :: Agreement a -> Agreement a -> Bool
$c<= :: forall a. Ord a => Agreement a -> Agreement a -> Bool
< :: Agreement a -> Agreement a -> Bool
$c< :: forall a. Ord a => Agreement a -> Agreement a -> Bool
compare :: Agreement a -> Agreement a -> Ordering
$ccompare :: forall a. Ord a => Agreement a -> Agreement a -> Ordering
Ord, Int -> Agreement a -> ShowS
forall a. Show a => Int -> Agreement a -> ShowS
forall a. Show a => [Agreement a] -> ShowS
forall a. Show a => Agreement a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Agreement a] -> ShowS
$cshowList :: forall a. Show a => [Agreement a] -> ShowS
show :: Agreement a -> String
$cshow :: forall a. Show a => Agreement a -> String
showsPrec :: Int -> Agreement a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Agreement a -> ShowS
Show)

-- | 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

-- | Not the only possible instance: see introduction
instance Applicative Agreement where
  pure :: forall a. a -> Agreement a
pure = forall a. a -> Agreement a
Somebody
  Agreement (a -> b)
Nobody     <*> :: forall a b. Agreement (a -> b) -> Agreement a -> Agreement b
<*> Agreement a
_ = forall a. Agreement a
Nobody
  Agreement (a -> b)
Anybody    <*> Agreement a
_ = forall a. Agreement a
Anybody
  Somebody a -> b
f <*> Agreement a
x = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Agreement a
x
  liftA2 :: forall a b c.
(a -> b -> c) -> Agreement a -> Agreement b -> Agreement c
liftA2 a -> b -> c
_ Agreement a
Nobody       Agreement b
_ = forall a. Agreement a
Nobody
  liftA2 a -> b -> c
_ Agreement a
Anybody      Agreement b
_ = forall a. Agreement a
Anybody
  liftA2 a -> b -> c
f (Somebody a
x) Agreement b
y = a -> b -> c
f a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Agreement b
y

instance Monad Agreement where
  return :: forall a. a -> Agreement a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Agreement a
Nobody     >>= :: forall a b. Agreement a -> (a -> Agreement b) -> Agreement b
>>= a -> Agreement b
_ = forall a. Agreement a
Nobody
  Agreement a
Anybody    >>= a -> Agreement b
_ = forall a. Agreement a
Anybody
  Somebody a
x >>= a -> Agreement b
f = a -> Agreement b
f a
x

instance (Eq a) => Semigroup (Agreement a) where
  Agreement a
Nobody     <> :: Agreement a -> Agreement a -> Agreement a
<> Agreement a
_          = forall a. Agreement a
Nobody
  Agreement a
Anybody    <> Agreement a
x          = Agreement a
x
  Somebody a
_ <> Agreement a
Nobody     = forall a. Agreement a
Nobody
  Somebody a
x <> Agreement a
Anybody    = forall a. a -> Agreement a
Somebody a
x
  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