[Haskell-cafe] What's the modern way to apply a polymorphic function to a Dynamic value in GHC 8.8 and onwards?
YueCompl
compl.yue at icloud.com
Tue Apr 13 14:48:40 UTC 2021
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 <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 <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 <mailto: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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20210413/5e931549/attachment-0001.html>
More information about the Haskell-Cafe
mailing list