What's the modern way to apply a polymorphic function to a Dynamic value in GHC 8.8 and onwards?

Tue Apr 13 15:02:26 UTC 2021

Having more examples and docs in the corresponding module might be the best
first step toward that.

On Tue, Apr 13, 2021, 10:00 YueCompl via ghc-devs <ghc-devs at haskell.org>
wrote:

> A followup wish I have:
>
> ```hs
> case io `eqTypeRep` typeRep @IO of
> Just HRefl -> Dynamic TypeRep <$> monotypedAct
> Nothing -> naAlt -- not an IO action
> ```
>
> The `Just HRefl` part as in above remains hard to understand for me, I had
> glanced it in doc of the 'Type.Reflection' module earlier, but had no
> chance to figure out the usage of `eqTypeRep` to be like this, at least on
> my own. The community is very helpful in this regards, in leading me to it.
> But may there can be better surface syntax / usage hints that more
> intuitive, i.e. costing less effort to reach the solution? I anticipate
> improvements but apparently lack expertise for progress, I tried `Just {}`
> and it won't compile already...
>
> I mean, things are already great as far, well, maybe the learning
> experience can be made even better.
>
> Best,
> Compl
>
>
> On 2021-04-13, at 22:07, YueCompl via ghc-devs <ghc-devs at haskell.org>
> wrote:
>
> 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.
>
> Thanks to Erik, Vlad and Jaro again for your help.
>
> u/Iceland_jack made a ticket to [add pattern TypeRep to Type.Reflection](
> https://gitlab.haskell.org/ghc/ghc/-/issues/19691) and appears it's very
> welcomed. Though I don't expect it get shipped very soon or even could be
> back ported to GHC 8.8, so I end up with this shim:
>
> (there `PolyKinds` appears some unusual to be put into my `.cabal` due to
> its syntax change can break some of my existing code)
>
> ```hs
> {-# 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
>
> ```
>
> And my test case being a little more complex than the very first example,
> might be easier for others to grasp the usage, it runs like this:
>
> ```console
> λ> import PoC.DynPoly
> λ> testDynHold
> First got Nothing
> Then got Just 3
> λ>
> ```
>
> With the code:
>
> ```hs
> 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
> ```
>
> Thanks with best regards,
> Compl
>
>
> On 2021-04-13, at 02:50, Erik Hesselink <hesselink at gmail.com> wrote:
>
> That is a lot, I'm not sure I understand that pattern synonym. Using
> `withTypeable` instead works for me:
>
> holdEvent :: Dynamic -> Dynamic
> holdEvent (Dynamic tr x) =
>   case tr of
>     App ft at ->
>       case ft `eqTypeRep` typeRep @EventSink of
>         Just HRefl -> withTypeable at $ toDyn (hcHoldEvent x)
>         Nothing -> error "to handle"
>     _ -> error "to handle"
>
> Cheers,
>
> Erik
>
>
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
>
> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-devs/attachments/20210413/04476cf2/attachment.html>