@@ -3,6 +3,7 @@
33{-# LANGUAGE RecursiveDo #-}
44{-# LANGUAGE StandaloneDeriving #-}
55{-# LANGUAGE ConstraintKinds #-}
6+{-# LANGUAGE DefaultSignatures #-}
67{-# LANGUAGE FlexibleContexts #-}
78{-# LANGUAGE FlexibleInstances #-}
89{-# LANGUAGE GADTs #-}
@@ -62,10 +63,9 @@ import Control.Lens hiding (Bifunctor, bimap, universe, element)
6263import Control.Monad ((<=<))
6364import Control.Monad.Fix
6465import Control.Monad.Primitive
66+import Control.Monad.Reader
6567import Control.Monad.Ref
66−import Control.Monad.Trans
6768import Control.Monad.Trans.Control
68−import Control.Monad.Trans.Reader
6969import Data.Coerce
7070import Data.Dependent.Sum (DSum (..))
7171import Data.GADT.Compare
@@ -101,13 +101,21 @@ pattern a :~ b <- a :=> (coerceDynamic . getCompose -> b)
101101
102102class Routed t r m | m -> t r where
103103 askRoute :: m (Dynamic t r)
104+ default askRoute :: (Monad m', MonadTrans f, Routed t r m', m ~ f m') => m (Dynamic t r)
105+ askRoute = lift askRoute
104106
105107instance Monad m => Routed t r (RoutedT t r m) where
106108 askRoute = RoutedT ask
107109
110+instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m)
111+
108112newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }
109113 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)
110114
115+instance MonadReader r' m => MonadReader r' (RoutedT t r m) where
116+ ask = lift ask
117+ local = mapRoutedT . local
118+
111119instance HasJSContext m => HasJSContext (RoutedT t r m) where
112120 type JSContextPhantom (RoutedT t r m) = JSContextPhantom m
113121 askJSContext = lift askJSContext
@@ -284,13 +292,17 @@ runSetRouteT = runEventWriterT . unSetRouteT
284292class Reflex t => SetRoute t r m | m -> t r where
285293 setRoute :: Event t r -> m ()
286294 modifyRoute :: Event t (r -> r) -> m ()
295+ default modifyRoute :: (Monad m', MonadTrans f, SetRoute t r m', m ~ f m') => Event t (r -> r) -> m ()
296+ modifyRoute = lift . modifyRoute
297+
287298 setRoute = modifyRoute . fmap const
288299
289300instance (Reflex t, Monad m) => SetRoute t r (SetRouteT t r m) where
290301 modifyRoute = SetRouteT . tellEvent . fmap Endo
291302
292−instance (Monad m, SetRoute t r m) => SetRoute t r (RoutedT t r' m) where
293− modifyRoute = lift . modifyRoute
303+instance (Monad m, SetRoute t r m) => SetRoute t r (RoutedT t r' m)
304+
305+instance (Monad m, SetRoute t r m) => SetRoute t r (ReaderT r' m)
294306
295307instance (PerformEvent t m, Prerender js t m, Monad m, Reflex t) => Prerender js t (SetRouteT t r m) where
296308 type Client (SetRouteT t r m) = SetRouteT t r (Client m)
@@ -347,6 +359,8 @@ instance (Monad m, MonadQuery t vs m) => MonadQuery t vs (SetRouteT t r m) where
347359
348360class RouteToUrl r m | m -> r where
349361 askRouteToUrl :: m (r -> Text)
362+ default askRouteToUrl :: (Monad m', MonadTrans f, RouteToUrl r m', m ~ f m') => m (r -> Text)
363+ askRouteToUrl = lift askRouteToUrl
350364
351365newtype RouteToUrlT r m a = RouteToUrlT { unRouteToUrlT :: ReaderT (r -> Text) m a }
352366 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)
@@ -364,10 +378,10 @@ instance Monad m => RouteToUrl r (RouteToUrlT r m) where
364378 askRouteToUrl = RouteToUrlT ask
365379
366380instance (Monad m, RouteToUrl r m) => RouteToUrl r (SetRouteT t r' m) where
367− askRouteToUrl = lift askRouteToUrl
368381
369382instance (Monad m, RouteToUrl r m) => RouteToUrl r (RoutedT t r' m) where
370− askRouteToUrl = lift askRouteToUrl
383+
384+instance (Monad m, RouteToUrl r m) => RouteToUrl r (ReaderT r' m) where
371385
372386instance (Monad m, RouteToUrl r m) => RouteToUrl r (RequesterT t req rsp m) where
373387 askRouteToUrl = lift askRouteToUrl