Avoiding an incomplete pattern match

Question

Consider the following code:

data A
data B

f :: A -> B
f = undefined

data T = TA A | TB B
data ListT = ListTA [A] | ListTB [B]

g :: [T] -> ListT
g l = 
  let
    f' :: T -> B
    f' (TA x) = f x
    f' (TB x) = x
    isA :: T -> Bool
    isA TA{} = True
    isA TB{} = False
  in
    case (all isA l) of
      True -> ListTA (map (\(TA x) -> x) l)
      False -> ListTB (map f' l)

main = pure ()

The idea behind this is I've got a list of either As or Bs mixed together. I can convert A -> B but not the other way around. Based on this list, I want to make either a list of As or list of Bs, the former if all my original list elements are As, the latter if at least one is a B.

The above code compiles (and I'm guessing will work) but the incomplete pattern match in the map (\(TA x) -> x) l makes me just a little uncomfortable. Is such an incomplete match just a necessity of what I'm doing here? Also, am I reinventing the wheel, is there something that generalises what I'm doing here?

Answer 1

The only way I can think of is something like

tryA :: [T] -> Maybe [A]
tryA [] = []
tryA (t:ts) =
  case t of
    TA x -> do xs <- tryA ts; return (x:xs)
    TB _ -> Nothing

If tryA returns nothing, then do map f' l as before.

This way you're doing the all isA l and the map in a single pass, and it avoids an incomplete pattern.

Answer 2

I'd structure it like this: build two lists - one full of As and one full of Bs - with the effect that building the list of As could fail. One can build a Monoid which implements this logic and foldMap into it.

Since one could fail to build a list of As, we'll need to build this Monoid on top of Maybe. The behaviour we want comes from Maybe's Applicative instance: if either of mappend's arguments is Nothing then the whole thing fails, otherwise we want to use mappend to combine the two results. This is a general recipe for combining an Applicative and a Monoid. Concretely:

newtype WrappedApplicative f a = Wrap { unWrap :: f a }

instance (Applicative f, Monoid m) => Monoid (WrappedApplicative f m) where
    mempty = pure mempty
    Wrap x `mappend` Wrap y = Wrap $ liftA2 mappend x y

I don't know if this newtype is somewhere in base. It seems like the sort of thing that would be there but I couldn't find it.

Without further ado, here's the Monoid we'll be foldMapping into:

type Result = ([B], WrappedApplicative Maybe [A])

I'm borrowing (a, b)'s Monoid instance, which delegates in parallel to a and b's Monoid instances.

getAsOrToBs :: [Either A B] -> Either [A] [B]
getAsOrToBs = fromResult . foldMap toResult
    where toResult (Left a) = ([aToB a], Wrap (Just [a]))
          toResult (Right b) = ([b], Wrap Nothing)
          fromResult (_, Wrap (Just as)) = Left as
          fromResult (bs, Wrap Nothing) = Right bs

Alternatively, with foldr:

getAsOrToBs :: [Either A B] -> Either [A] [B]
getAsOrToBs = fromResult . foldr f ([], Just [])
    where f (Left a) (bs, mas) = (aToB a : bs, fmap (a:) mas)
          f (Right b) (bs, _) = (b:bs, Nothing)
          fromResult (_, Just as) = Left as
          fromResult (bs, Nothing) = Right bs

Look, ma, no partial functions!