58f370b · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

Merge pull request #341 from obsidiansystems/ae-reader-instances

58f370bAli Abrar8 years ago

lib/route/src/Obelisk/Route/Frontend.hs+20−6

compare with master

unifiedsplit

@@ -3,6 +3,7 @@

3{-# LANGUAGE RecursiveDo #-}

4{-# LANGUAGE StandaloneDeriving #-}

5{-# LANGUAGE ConstraintKinds #-}

6+{-# LANGUAGE DefaultSignatures #-}

6{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleInstances #-}

8{-# LANGUAGE FlexibleInstances #-}

8{-# LANGUAGE GADTs #-}

9{-# LANGUAGE GADTs #-}

@@ -62,10 +63,9 @@ import Control.Lens hiding (Bifunctor, bimap, universe, element)

62import Control.Monad ((<=<))

63import Control.Monad ((<=<))

63import Control.Monad.Fix

64import Control.Monad.Fix

64import Control.Monad.Primitive

65import Control.Monad.Primitive

66+import Control.Monad.Reader

65import Control.Monad.Ref

67import Control.Monad.Ref

66−import Control.Monad.Trans

67import Control.Monad.Trans.Control

68import Control.Monad.Trans.Control

68−import Control.Monad.Trans.Reader

69import Data.Coerce

70import Data.Dependent.Sum (DSum (..))

71import Data.GADT.Compare

@@ -101,13 +101,21 @@ pattern a :~ b <- a :=> (coerceDynamic . getCompose -> b)

101

102class Routed t r m | m -> t r where

103 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

104

106

105instance Monad m => Routed t r (RoutedT t r m) where

107instance Monad m => Routed t r (RoutedT t r m) where

106 askRoute = RoutedT ask

108 askRoute = RoutedT ask

107

109

110+instance (Monad m, Routed t r m) => Routed t r (ReaderT r' m)

111+

108newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }

112newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }

109 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)

113 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)

110

114

115+instance MonadReader r' m => MonadReader r' (RoutedT t r m) where

116+ ask = lift ask

117+ local = mapRoutedT . local

118+

111instance HasJSContext m => HasJSContext (RoutedT t r m) where

119instance HasJSContext m => HasJSContext (RoutedT t r m) where

112 type JSContextPhantom (RoutedT t r m) = JSContextPhantom m

120 type JSContextPhantom (RoutedT t r m) = JSContextPhantom m

113 askJSContext = lift askJSContext

121 askJSContext = lift askJSContext

@@ -284,13 +292,17 @@ runSetRouteT = runEventWriterT . unSetRouteT

284class Reflex t => SetRoute t r m | m -> t r where

292class Reflex t => SetRoute t r m | m -> t r where

285 setRoute :: Event t r -> m ()

293 setRoute :: Event t r -> m ()

286 modifyRoute :: Event t (r -> r) -> m ()

294 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+

287 setRoute = modifyRoute . fmap const

298 setRoute = modifyRoute . fmap const

288

299

289instance (Reflex t, Monad m) => SetRoute t r (SetRouteT t r m) where

300instance (Reflex t, Monad m) => SetRoute t r (SetRouteT t r m) where

290 modifyRoute = SetRouteT . tellEvent . fmap Endo

301 modifyRoute = SetRouteT . tellEvent . fmap Endo

291

302

292−instance (Monad m, SetRoute t r m) => SetRoute t r (RoutedT t r' m) where

303+instance (Monad m, SetRoute t r m) => SetRoute t r (RoutedT t r' m)

293− modifyRoute = lift . modifyRoute

304+

305+instance (Monad m, SetRoute t r m) => SetRoute t r (ReaderT r' m)

294

306

295instance (PerformEvent t m, Prerender js t m, Monad m, Reflex t) => Prerender js t (SetRouteT t r m) where

307instance (PerformEvent t m, Prerender js t m, Monad m, Reflex t) => Prerender js t (SetRouteT t r m) where

296 type Client (SetRouteT t r m) = SetRouteT t r (Client m)

308 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

347

359

348class RouteToUrl r m | m -> r where

360class RouteToUrl r m | m -> r where

349 askRouteToUrl :: m (r -> Text)

361 askRouteToUrl :: m (r -> Text)

362+ default askRouteToUrl :: (Monad m', MonadTrans f, RouteToUrl r m', m ~ f m') => m (r -> Text)

363+ askRouteToUrl = lift askRouteToUrl

350

364

351newtype RouteToUrlT r m a = RouteToUrlT { unRouteToUrlT :: ReaderT (r -> Text) m a }

365newtype RouteToUrlT r m a = RouteToUrlT { unRouteToUrlT :: ReaderT (r -> Text) m a }

352 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomRenderHook t)

366 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

364 askRouteToUrl = RouteToUrlT ask

378 askRouteToUrl = RouteToUrlT ask

365

379

366instance (Monad m, RouteToUrl r m) => RouteToUrl r (SetRouteT t r' m) where

380instance (Monad m, RouteToUrl r m) => RouteToUrl r (SetRouteT t r' m) where

367− askRouteToUrl = lift askRouteToUrl

368

381

369instance (Monad m, RouteToUrl r m) => RouteToUrl r (RoutedT t r' m) where

382instance (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

371

385

372instance (Monad m, RouteToUrl r m) => RouteToUrl r (RequesterT t req rsp m) where

386instance (Monad m, RouteToUrl r m) => RouteToUrl r (RequesterT t req rsp m) where

373 askRouteToUrl = lift askRouteToUrl

387 askRouteToUrl = lift askRouteToUrl