git.iko.soy/obelisk
on master help sign in
More custom route support
commit01e4e5e0350df7610cdfe726bec8f09bb0226158 authorRyan Trinkle <ryan.trinkle@gmail.com> dateWed 11 Jul 2018, 19:21 (8 years ago) parent75c3b86
4 files changed+32−5
compare with master
unifiedsplit
lib/frontend/src/Obelisk/Frontend.hs+1−1 lib/route/obelisk-route.cabal+1 lib/route/src/Obelisk/Route/Frontend.hs+18−2 lib/run/src/Obelisk/Run.hs+12−2
lib/frontend/src/Obelisk/Frontend.hs+1−1
@@ -37,7 +37,7 @@ type ObeliskWidget t route m =
3737
3838data Frontend route = Frontend
3939 { _frontend_head :: !(forall t m. ObeliskWidget t route m => RoutedT t (route) m ())
40− , _frontend_body :: !(forall t m. ObeliskWidget t route m => RoutedT t (route) m ())
40+ , _frontend_body :: !(forall t m x. (MonadWidget t m, HasJS x m, EventWriter t (Endo route) m) => RoutedT t (route) m ())
4141 , _frontend_routeEncoder :: !(Encoder (Either Text) (Either Text) (route) PageName)
4242 , _frontend_title :: !(route -> Text)
4343 , _frontend_notFoundRoute :: !(Text -> route)
lib/route/obelisk-route.cabal+1
@@ -19,6 +19,7 @@ library
1919 monad-control,
2020 mtl,
2121 network-uri,
22+ ref-tf,
2223 reflex,
2324 reflex-dom,
2425 text,
lib/route/src/Obelisk/Route/Frontend.hs+18−2
@@ -40,6 +40,7 @@ import Control.Category (Category (..), (.))
4040import Control.Category.Cartesian
4141import Control.Lens hiding (Bifunctor, bimap, universe)
4242import Control.Monad.Fix
43+import Control.Monad.Ref
4344import Control.Monad.Trans
4445import Control.Monad.Trans.Control
4546import Control.Monad.Trans.Reader
@@ -60,7 +61,7 @@ import Reflex.Dynamic
6061import Reflex.Dom.Builder.Class
6162import Data.Type.Coercion
6263import Language.Javascript.JSaddle --TODO: Get rid of this - other platforms can also be routed
63−import Reflex.Dom.Location
64+import Reflex.Dom.Core
6465import qualified GHCJS.DOM.Types as DOM
6566import Network.URI
6667
@@ -77,7 +78,22 @@ instance Monad m => Routed t r (RoutedT t r m) where
7778 askRoute = RoutedT ask
7879
7980newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }
80− deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t)
81+ deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, HasJSContext, MonadIO, MonadJSM)
82+
83+instance PerformEvent t m => PerformEvent t (RoutedT t r m) where
84+ type Performable (RoutedT t r m) = Performable m
85+ performEvent = lift . performEvent
86+ performEvent_ = lift . performEvent_
87+
88+instance MonadRef m => MonadRef (RoutedT t r m) where
89+ type Ref (RoutedT t r m) = Ref m
90+ newRef = lift . newRef
91+ readRef = lift . readRef
92+ writeRef r = lift . writeRef r
93+
94+instance HasJS x m => HasJS x (RoutedT t r m) where
95+ type JSX (RoutedT t r m) = JSX m
96+ liftJS = lift . liftJS
8197
8298deriving instance EventWriter t w m => EventWriter t w (RoutedT t r m)
8399
lib/run/src/Obelisk/Run.hs+12−2
@@ -6,11 +6,15 @@
66{-# LANGUAGE GADTs #-}
77{-# LANGUAGE KindSignatures #-}
88{-# LANGUAGE LambdaCase #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
910{-# LANGUAGE OverloadedStrings #-}
1011{-# LANGUAGE Rank2Types #-}
1112{-# LANGUAGE RecursiveDo #-}
1213{-# LANGUAGE ScopedTypeVariables #-}
1314{-# LANGUAGE TemplateHaskell #-}
15+{-# LANGUAGE TypeFamilies #-}
16+{-# LANGUAGE UndecidableInstances #-}
17+{-# OPTIONS_GHC -fno-warn-orphans #-} -- Due to instance HasJS x (EventWriterT t w m)
1418module Obelisk.Run where
1519
1620import Prelude hiding ((.), id)
@@ -129,6 +133,11 @@ void1Encoder = Encoder $ pure $ ValidEncoder
129133
130134type Widget' x = ImmediateDomBuilderT DomTimeline (PostBuildT DomTimeline (WithJSContextSingleton x (PerformEventT DomTimeline DomHost))) --TODO: Make this more abstract
131135
136+--TODO: Upstream
137+instance HasJS x m => HasJS x (EventWriterT t w m) where
138+ type JSX (EventWriterT t w m) = JSX m
139+ liftJS = lift . liftJS
140+
132141{-# INLINABLE attachWidget''' #-}
133142attachWidget''' :: (Ref m ~ Ref IO, MonadIO m, MonadReflexHost DomTimeline m, MonadRef m) => (EventChannel -> PerformEventT DomTimeline m (a, IORef (Maybe (EventTrigger DomTimeline ())))) -> m (a, FireCommand DomTimeline m)
134143attachWidget''' w = do
@@ -188,8 +197,9 @@ obeliskApp opts frontend backend = do
188197 _ -> flip jsaddle sendResponse $ req
189198 { W.pathInfo = fst $ _validEncoder_encode jsaddleWarpRouteValidEncoder jsaddleRoute
190199 }
191− Left _ -> sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] html
192− _ -> backend req sendResponse
200+ _ -> if W.pathInfo req == [] --TODO: This should just use the real parsing logic for the app
201+ then sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] html
202+ else backend req sendResponse
193203
194204indexHtml :: StaticWidget () () -> IO ByteString
195205indexHtml h = do