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@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 <hessel...@gmail.com
>> <mailto:hessel...@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@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
_______________________________________________
ghc-devs mailing list
ghc-devs@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
