@@ -11,7 +11,7 @@
1111{-# LANGUAGE TypeFamilies #-}
1212{-# LANGUAGE UndecidableInstances #-}
1313
14−module Reflex.Dom.NestedRoute where
14+module Reflex.Dom.Routing.Nested where
1515
1616import Control.Lens (Rewrapped, Wrapped (..), iso, to,
1717 (^.))
@@ -32,7 +32,6 @@ import Data.Maybe (listToMaybe)
3232import Data.Text (Text)
3333import qualified Data.Text as T
3434import Data.Text.Encoding (decodeUtf8, encodeUtf8)
35−import Foreign.JavaScript.TH
3635import Language.Javascript.JSaddle (MonadJSM)
3736import Reflex
3837import Reflex.Dom.Builder.Class
@@ -114,6 +113,8 @@ instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RouteT t s
114113 placeRawElement = lift . placeRawElement
115114 wrapRawElement e = lift . wrapRawElement e
116115
116+instance (Monad m, NotReady t m) => NotReady t (RouteT t segment m)
117+
117118instance MonadReader r m => MonadReader r (RouteT t segment m) where
118119 ask = lift ask
119120 local f (RouteT a) = RouteT $ mapReaderT (local f) a
@@ -127,14 +128,25 @@ instance HasRoute t segment m => HasRoute t segment (EventWriterT t w m) where
127128instance EventWriter t w m => EventWriter t w (RouteT t segment m) where
128129 tellEvent = lift . tellEvent
129130
131+instance HasRoute t segment m => HasRoute t segment (DynamicWriterT t w m) where
132+ routeContext = lift routeContext
133+ withSegments f (DynamicWriterT a) = DynamicWriterT $ StrictState.mapStateT (withSegments f) a
134+
135+instance DynamicWriter t w m => DynamicWriter t w (RouteT t segment m) where
136+ tellDyn = lift . tellDyn
137+
130138instance HasDocument m => HasDocument (RouteT t segment m)
131−instance HasJSContext m => HasJSContext (RouteT t segment m) where
132− type JSContextPhantom (RouteT t segment m) = JSContextPhantom m
133− askJSContext = RouteT askJSContext
139+
134140#ifndef ghcjs_HOST_OS
135141instance MonadJSM m => MonadJSM (RouteT t segment m)
136142#endif
137143
144+deriving instance DomRenderHook t m => DomRenderHook t (RouteT t segment m)
145+
146+instance (Prerender t m, Monad m, Reflex t) => Prerender t (RouteT t segment m) where
147+ type Client (RouteT t segment m) = RouteT t segment (Client m)
148+ prerender (RouteT a) (RouteT b) = RouteT $ prerender a b
149+
138150
139151instance PrimMonad m => PrimMonad (RouteT t segment m) where
140152 type PrimState (RouteT t segment m) = PrimState m
@@ -180,8 +192,11 @@ runRouteWithPathInFragment
180192 => RouteT t Text m (Event t [Text])
181193 -> m ()
182194runRouteWithPathInFragment = runRoute
183− (T.splitOn "/" . T.dropAround (=='/') . fragAsText)
195+ (nullTextToEmptyList . T.splitOn "/" . T.dropAround (=='/') . fragAsText)
184196 (\oldUrl -> setFrag oldUrl . T.intercalate "/")
197+ where
198+ nullTextToEmptyList [""] = []
199+ nullTextToEmptyList x = x
185200
186201-- | Introduces a new "layer" in the nested routing tree. The given function takes
187202-- the current layer's route segment and builds the DOM for that segment.
@@ -243,9 +258,11 @@ nextRouteSegment = do
243258parentRouteSegments :: (MonadHold t m, MonadFix m, HasRoute t segment m, Eq segment) => m (Dynamic t [segment])
244259parentRouteSegments = do
245260 ctx <- routeContext
246− holdUniqDyn $ do
247− allSegments <- _routeContext_allSegments ctx
248− pure $ take (_routeContext_currentDepth ctx - 1) allSegments
261+ holdUniqDyn $ take (_routeContext_currentDepth ctx) <$> _routeContext_allSegments ctx
262+
263+-- | Route segments from child layers.
264+childRouteSegments :: (MonadHold t m, MonadFix m, HasRoute t segment m, Eq segment) => m (Dynamic t [segment])
265+childRouteSegments = holdUniqDyn =<< _routeContext_nextSegments <$> routeContext
249266
250267-- | A simple helper that produces a routing event on 'getPostBuild'.
251268redirectLocally :: (PostBuild t m) => [segment] -> m (Event t [segment])