Newtype for deriving `Show1`

Show1Stuff.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveFunctor #-}

module Show1Stuff where

import Data.Functor.Classes

-- | Copy of `Maybe` where `Show1` is derived
data Maybe' a = Nothing' | Just' a
  deriving stock (Functor, Show)
  deriving (Show1) via (Identity1 Maybe')

----------

newtype Identity1 f a = Identity1 { runIdentity1 :: f a }

instance (Functor f, forall a. Show a => Show (f a)) => Show1 (Identity1 f) where
  liftShowsPrec :: forall a. (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Identity1 f a -> ShowS
  liftShowsPrec sp _ p = showsPrec p . fmap (WSD sp) . runIdentity1

-- | Pass `showsPrec` explicitly
data WithShowDict a = WSD (Int -> a -> ShowS) a
instance Show (WithShowDict a) where
  showsPrec p (WSD showsPrecF x) = showsPrecF p x