Total prism matching

Total.hs

import Control.Lens hiding (from, to)
import GHC.Generics

class Empty a where
  impossible :: a -> x
  default impossible :: (Generic a, GEmpty (Rep a)) => a -> x
  impossible = gimpossible . from

instance Empty Void where
  impossible = absurd

instance (Empty a, Empty b) => Empty (Either a b) where
  impossible (Left a) = impossible a
  impossible (Right b) = impossible b

instance Empty a => Empty ((,) a b) where
  impossible (a, _) = impossible a

class GEmpty f where
  gimpossible :: f a -> x

instance GEmpty V1 where
  gimpossible _ = undefined

instance (GEmpty a, GEmpty b) => GEmpty (a :+: b) where
  gimpossible (L1 l) = gimpossible l
  gimpossible (R1 r) = gimpossible r

instance Empty a => GEmpty (K1 i a) where
  gimpossible (K1 k) = impossible k

instance GEmpty a => GEmpty (M1 i c a) where
  gimpossible (M1 m) = gimpossible m

instance GEmpty a => GEmpty (a :*: b) where
  gimpossible (a :*: _) = gimpossible a

_case :: Empty a => a -> x
_case = impossible

_default :: x -> a -> x
_default x _ = x

on ::
  APrism s t a Void ->
  (a -> o) ->
  (t -> o) ->
  s ->
  o
on thisPrism onMatch nonMatch input = case (matching thisPrism input) of
  Left l -> nonMatch l
  Right r -> onMatch r

example :: Either Char Int -> String
example =
  _case
    & on _Left (\c -> replicate 3 c)
    & on _Right (\n -> replicate n '!')