on master help sign in
Add reader/route instances
commit141dbea8b89096322b0b0f57d1ffa06fe480365d authorAlexandre Esteves <alexandre.fmp.esteves@gmail.com> dateMon 21 Jan 2019, 02:51 (8 years ago) parent4cdeba6
1 file changed+14−2
lib/route/src/Obelisk/Route/Frontend.hs+14−2
lib/route/src/Obelisk/Route/Frontend.hs+14−2
@@ -57,10 +57,9 @@ import Control.Category.Cartesian
5757import Control.Lens hiding (Bifunctor, bimap, universe, element)
5858import Control.Monad.Fix
5959import Control.Monad.Primitive
60+import Control.Monad.Reader
6061import Control.Monad.Ref
61−import Control.Monad.Trans
6262import Control.Monad.Trans.Control
63−import Control.Monad.Trans.Reader
6463import Data.Coerce
6564import Data.Constraint (Dict (..))
6665import Data.Dependent.Sum (DSum (..))
@@ -101,9 +100,16 @@ class Routed t r m | m -> t r where
101100instance Monad m => Routed t r (RoutedT t r m) where
102101 askRoute = RoutedT ask
103102
103+instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m) where
104+ askRoute = lift askRoute
105+
104106newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }
105107 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument)
106108
109+instance MonadReader r' m => MonadReader r' (RoutedT t r m) where
110+ ask = lift ask
111+ local = mapRoutedT . local
112+
107113instance HasJSContext m => HasJSContext (RoutedT t r m) where
108114 type JSContextPhantom (RoutedT t r m) = JSContextPhantom m
109115 askJSContext = lift askJSContext
@@ -261,6 +267,9 @@ instance (Reflex t, Monad m) => SetRoute t r (SetRouteT t r m) where
261267instance (Monad m, SetRoute t r m) => SetRoute t r (RoutedT t r' m) where
262268 modifyRoute = lift . modifyRoute
263269
270+instance (Monad m, SetRoute t r m) => SetRoute t r (ReaderT r' m) where
271+ modifyRoute = lift . modifyRoute
272+
264273instance Prerender js m => Prerender js (SetRouteT t r m) where
265274 prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
266275
@@ -328,6 +337,9 @@ instance (Monad m, RouteToUrl r m) => RouteToUrl r (SetRouteT t r' m) where
328337instance (Monad m, RouteToUrl r m) => RouteToUrl r (RoutedT t r' m) where
329338 askRouteToUrl = lift askRouteToUrl
330339
340+instance (Monad m, RouteToUrl r m) => RouteToUrl r (ReaderT r' m) where
341+ askRouteToUrl = lift askRouteToUrl
342+
331343instance HasJSContext m => HasJSContext (RouteToUrlT r m) where
332344 type JSContextPhantom (RouteToUrlT r m) = JSContextPhantom m
333345 askJSContext = lift askJSContext