After struggled this far, I decide that I can neither trivially understand `pattern TypeRep`, nor the `withTypeable` at core. But this is what really amazing with Haskell, GHC and the community here - I can get my job done even without full understanding of what's going on under the hood, so long as the compiler says it's okay! The warning has gone due to unknown reason after I refactored the code a bit, surprisingly but well, I feel safe and comfort to use it now.

{-# LANGUAGE PolyKinds #-}

module Dyn.Shim
  ( pattern TypeRep,
    dynPerformIO,
    dynPerformSTM,
    dynContSTM,
  )
where

import Control.Concurrent.STM (STM)
import Data.Dynamic (Dynamic (..), Typeable)
import Type.Reflection
  ( TypeRep,
    eqTypeRep,
    typeRep,
    withTypeable,
    pattern App,
    type (:~~:) (HRefl),
  )
import Prelude

data TypeableInstance a where
  TypeableInstance :: Typeable a => TypeableInstance a

typeableInstance :: TypeRep a -> TypeableInstance a
typeableInstance tr = withTypeable tr TypeableInstance

{- ORMOLU_DISABLE -}

-- | Shim for the proposed one at:
--   https://gitlab.haskell.org/ghc/ghc/-/issues/19691
pattern TypeRep :: forall k (a :: k). () => Typeable a => TypeRep a
pattern TypeRep <- (typeableInstance -> TypeableInstance)
  where TypeRep = typeRep

{- ORMOLU_ENABLE -}

-- | Perform a polymorphic IO action which is wrapped in a 'Dynamic'
--
-- The specified 'naAlt' action will be performed instead, if the wrapped
-- computation is not applicable, i.e. not really an IO action.
dynPerformIO :: IO Dynamic -> Dynamic -> IO Dynamic
dynPerformIO naAlt (Dynamic trAct monotypedAct) = case trAct of
  App io TypeRep ->
    case io `eqTypeRep` typeRep @IO of
      Just HRefl -> Dynamic TypeRep <$> monotypedAct
      Nothing -> naAlt -- not an IO action
  _ -> naAlt -- not even a poly-type

-- | Perform a polymorphic STM action which is wrapped in a 'Dynamic'
--
-- The specified 'naAlt' action will be performed instead, if the wrapped
-- computation is not applicable, i.e. not really an STM action.
dynPerformSTM :: STM Dynamic -> Dynamic -> STM Dynamic
dynPerformSTM naAlt (Dynamic trAct monotypedAct) = case trAct of
  App io TypeRep ->
    case io `eqTypeRep` typeRep @STM of
      Just HRefl -> Dynamic TypeRep <$> monotypedAct
      Nothing -> naAlt -- not an STM action
  _ -> naAlt -- not even a poly-type

-- | Perform a polymorphic STM action which is wrapped in a 'Dynamic'
--
-- The specified 'naAlt' action will be performed instead, if the wrapped
-- computation is not applicable, i.e. not really an STM action.
dynContSTM :: STM () -> Dynamic -> (Dynamic -> STM ()) -> STM ()
dynContSTM naAlt (Dynamic trAct monotypedAct) !exit = case trAct of
  App io TypeRep ->
    case io `eqTypeRep` typeRep @STM of
      Just HRefl -> exit . Dynamic TypeRep =<< monotypedAct
      Nothing -> naAlt -- not an STM action
  _ -> naAlt -- not even a poly-type

module PoC.DynPoly where

import Control.Monad (void)
import Data.Dynamic (Dynamic (..), fromDynamic, toDyn)
import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)
import Dyn.Shim
import Type.Reflection (eqTypeRep, typeRep, pattern App, type (:~~:) (HRefl))
import Prelude

dynHoldEvent :: Dynamic -> Dynamic
dynHoldEvent (Dynamic trEvs monotypedEvs) =
  case trEvs of
    App trEs TypeRep ->
      case trEs `eqTypeRep` typeRep @EventSink of
        Just HRefl -> Dynamic TypeRep (holdEvent monotypedEvs)
        Nothing -> error "not an EventSink" -- to be handled properly
    _ -> error "even not a poly-type" -- to be handled properly
  where
    holdEvent :: forall a. EventSink a -> IO (TimeSeries a)
    holdEvent !evs = do
      !holder <- newIORef Nothing
      listenEvents evs $ writeIORef holder . Just
      return $ TimeSeries $ readIORef holder

data EventSink a = EventSink
  { listenEvents :: (a -> IO ()) -> IO (),
    publishEvent :: a -> IO ()
  }

newtype TimeSeries a = TimeSeries {readTimeSeries :: IO (Maybe a)}

newEventSink :: forall a. IO (EventSink a)
newEventSink = do
  !listeners <- newIORef []
  let listen listener = modifyIORef' listeners (listener :)
      publish a = readIORef listeners >>= void . mapM ($ a)
  return $ EventSink listen publish

testDynHold :: IO ()
testDynHold = do
  (evs :: EventSink Int) <- newEventSink
  let !dynEvs = toDyn evs
      !dynHold = dynHoldEvent dynEvs
  !dynTs <- dynPerformIO (error "bug: dyn type mismatch?") dynHold
  case fromDynamic dynTs of
    Nothing -> error "bug: unexpected dyn result type"
    Just (ts :: TimeSeries Int) -> do
      v0 <- readTimeSeries ts
      putStrLn $ "First got " <> show v0
      publishEvent evs 3
      v1 <- readTimeSeries ts
      putStrLn $ "Then got " <> show v1