O.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}

import Control.Monad
import Data.Foldable

data Entry a = Any | Every a | Exactly a | Many [a]
    deriving (Eq, Ord, Show, Functor, Foldable, Traversable)

instance Applicative Entry where
    pure = Exactly
    (<*>) = ap

instance Monad Entry where
    m >>= f = myJoin (fmap f m)

myJoin :: Entry (Entry a) -> Entry a
myJoin Any = Any
myJoin (Many xs) = Many (concatMap toList xs)
myJoin (Every (Every x)) = Every x
myJoin (Every (Exactly x)) = Every x
myJoin (Every (Many xs)) = Many xs
myJoin (Every Any) = Any
myJoin (Exactly y) = y