Add schmaversals

[masaeedu]

I have to apologize in advance, I don't have too much time to explain this or how I got here, but basically:

• Functor is to Contravariant what Applicative is to Divisible
• Traversable is to Applicative what Contraversable is to Divisible
• It looks like you can only give instances of Contraversable for functors that are isomorphic to Vec n for some n
• This sucks
• Lax monoidal contravariant functors that cohere tupling with Smash form a Smashable subclass of Divisible
• Divisible is to Contraversable what Smashable is to "Schmaversable", which would form a superclass of Contraversable
• Schamversables at last allow us to comprehend variable sized containers
• You can fill a Schmaversable container with piecewise comprehensions/predicates/folds/whatever Smashable contravariant thing you like
• When you schmaverse the container, of type t (p a), the resulting p (t a) represents a comprehension/predicate/fold/whatever that acts only on containers of agreeable shape.

I'll hopefully come back and flesh this out, but in the meantime, some code:

class Divisible f => Smashable f
  where
  liftS2 :: (a -> Smash b c) -> f b -> f c -> f a

class Functor t => Schmaversable t
  where
  schmaverse :: Smashable f => t (f a) -> f (t a)

instance Schmaversable []
  where
  schmaverse = \case
    [] -> conquer
    x : xs -> liftS2 hole' x $ schmaverse xs

newtype MaybePredicate a = MaybePredicate { getMaybePredicate :: a -> Maybe Bool }
  deriving (Contravariant, Divisible, Decidable) via (Op (Ap Maybe All))

instance Smashable MaybePredicate
  where
  liftS2 f (MaybePredicate p) (MaybePredicate q) = MaybePredicate $ smash Nothing (liftA2 (&&)) . bimap p q . f

test :: [String] -> Maybe Bool
test = getMaybePredicate $ schmaverse $
  [ MaybePredicate $ Just . (== "foo")
  , MaybePredicate $ Just . (== "bar")
  ]

-- $> test ["foo", "bar"]
-- > Just True

-- $> test ["foo", "baz"]
-- > Just False

-- $> test ["foo"]
-- > Nothing

instance (Schmaversable x, Schmaversable y) => Schmaversable (Compose x y)
  where
  schmaverse (Compose fg) = contramap getCompose $ schmaverse $ fmap schmaverse fg

test2 :: [[String]] -> Maybe Bool
test2 = (. Compose) $ getMaybePredicate $ schmaverse $ Compose $ coerce $
  [ [ Just . (== "foo"), Just . (== "bar") ]
  , [ Just . (== "baz") ]
  , [ Just . (== "quux"), Just . (== "quarkle") ]
  ]

{- $>
test2 $
  [ [ "foo", "bar" ]
  , [ "baz" ]
  , [ "quux", "quarkle" ]
  ]
<$ -}
-- > Just True

{- $>
test2 $
  [ [ "foo", "bar" ]
  , [ "baz" ]
  , [ "quux", "baz" ]
  ]
<$ -}
-- > Just False

{- $>
test2 $
  [ [ "foo", "bar" ]
  , [ "baz" ]
  , [ "quux" ]
  ]
<$ -}
-- > Nothing