git.iko.soy/typeable/reflex-dom-nested-routing
on master help sign in
CHANGELOG.mdnew file+13
since splitsnapshots
unifiedsplit
@@ -0,0 +1,13 @@
1+# Change Log
2+
3+## 0.0.3
4+
5+ * **[Breaking change]** Reorganize modules.
6+
7+## 0.0.2
8+
9+ * **[Breaking change]** Fix `parentRouteSegments` which was giving "grandparent" route instead of parent.
10+
11+## 0.0.1
12+
13+ * Initial prototype.
README.md+4−1
@@ -1,5 +1,8 @@
1# Nested Routing for Reflex-DOM
1# Nested Routing for Reflex-DOM
2
2
3+[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)](http://www.haskell.org)
4+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)](https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29)
5+
3Example:
6Example:
4
7
5```haskell
8```haskell
@@ -18,7 +21,7 @@ app = runRouteWithPathInFragment $ do
18```haskell
21```haskell
19app = runRouteWithPathInFragment $ fmap snd $ runRouteWriterT $ do
22app = runRouteWithPathInFragment $ fmap snd $ runRouteWriterT $ do
20 void $ withRoute $ \route -> case fromMaybe "" route of
23 void $ withRoute $ \route -> case fromMaybe "" route of
21− "" -> tellRouteAs ["users"] <=< buttonClick "Open users"
24+ "" -> tellRouteAs ["users"] =<< buttonClick "Open users"
22 "users" -> users
25 "users" -> users
23 "test" -> codeToRun
26 "test" -> codeToRun
24 "settings" -> text "Settings"
27 "settings" -> text "Settings"
Reflex/Dom/NestedRoute.hs → Reflex/Dom/Routing/Nested.hsrenamed+26−9
@@ -11,7 +11,7 @@
11{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE UndecidableInstances #-}
12{-# LANGUAGE UndecidableInstances #-}
13
13
14−module Reflex.Dom.NestedRoute where
14+module Reflex.Dom.Routing.Nested where
15
15
16import Control.Lens (Rewrapped, Wrapped (..), iso, to,
16import Control.Lens (Rewrapped, Wrapped (..), iso, to,
17 (^.))
17 (^.))
@@ -32,7 +32,6 @@ import Data.Maybe (listToMaybe)
32import Data.Text (Text)
32import Data.Text (Text)
33import qualified Data.Text as T
33import qualified Data.Text as T
34import Data.Text.Encoding (decodeUtf8, encodeUtf8)
34import Data.Text.Encoding (decodeUtf8, encodeUtf8)
35−import Foreign.JavaScript.TH
36import Language.Javascript.JSaddle (MonadJSM)
35import Language.Javascript.JSaddle (MonadJSM)
37import Reflex
36import Reflex
38import Reflex.Dom.Builder.Class
37import Reflex.Dom.Builder.Class
@@ -114,6 +113,8 @@ instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RouteT t s
114 placeRawElement = lift . placeRawElement
113 placeRawElement = lift . placeRawElement
115 wrapRawElement e = lift . wrapRawElement e
114 wrapRawElement e = lift . wrapRawElement e
116
115
116+instance (Monad m, NotReady t m) => NotReady t (RouteT t segment m)
117+
117instance MonadReader r m => MonadReader r (RouteT t segment m) where
118instance MonadReader r m => MonadReader r (RouteT t segment m) where
118 ask = lift ask
119 ask = lift ask
119 local f (RouteT a) = RouteT $ mapReaderT (local f) a
120 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
127instance EventWriter t w m => EventWriter t w (RouteT t segment m) where
128instance EventWriter t w m => EventWriter t w (RouteT t segment m) where
128 tellEvent = lift . tellEvent
129 tellEvent = lift . tellEvent
129
130
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+
130instance HasDocument m => HasDocument (RouteT t segment m)
138instance HasDocument m => HasDocument (RouteT t segment m)
131−instance HasJSContext m => HasJSContext (RouteT t segment m) where
139+
132− type JSContextPhantom (RouteT t segment m) = JSContextPhantom m
133− askJSContext = RouteT askJSContext
134#ifndef ghcjs_HOST_OS
140#ifndef ghcjs_HOST_OS
135instance MonadJSM m => MonadJSM (RouteT t segment m)
141instance MonadJSM m => MonadJSM (RouteT t segment m)
136#endif
142#endif
137
143
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+
138
150
139instance PrimMonad m => PrimMonad (RouteT t segment m) where
151instance PrimMonad m => PrimMonad (RouteT t segment m) where
140 type PrimState (RouteT t segment m) = PrimState m
152 type PrimState (RouteT t segment m) = PrimState m
@@ -180,8 +192,11 @@ runRouteWithPathInFragment
180 => RouteT t Text m (Event t [Text])
192 => RouteT t Text m (Event t [Text])
181 -> m ()
193 -> m ()
182runRouteWithPathInFragment = runRoute
194runRouteWithPathInFragment = runRoute
183− (T.splitOn "/" . T.dropAround (=='/') . fragAsText)
195+ (nullTextToEmptyList . T.splitOn "/" . T.dropAround (=='/') . fragAsText)
184 (\oldUrl -> setFrag oldUrl . T.intercalate "/")
196 (\oldUrl -> setFrag oldUrl . T.intercalate "/")
197+ where
198+ nullTextToEmptyList [""] = []
199+ nullTextToEmptyList x = x
185
200
186-- | Introduces a new "layer" in the nested routing tree. The given function takes
201-- | Introduces a new "layer" in the nested routing tree. The given function takes
187-- the current layer's route segment and builds the DOM for that segment.
202-- the current layer's route segment and builds the DOM for that segment.
@@ -243,9 +258,11 @@ nextRouteSegment = do
243parentRouteSegments :: (MonadHold t m, MonadFix m, HasRoute t segment m, Eq segment) => m (Dynamic t [segment])
258parentRouteSegments :: (MonadHold t m, MonadFix m, HasRoute t segment m, Eq segment) => m (Dynamic t [segment])
244parentRouteSegments = do
259parentRouteSegments = do
245 ctx <- routeContext
260 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
249
266
250-- | A simple helper that produces a routing event on 'getPostBuild'.
267-- | A simple helper that produces a routing event on 'getPostBuild'.
251redirectLocally :: (PostBuild t m) => [segment] -> m (Event t [segment])
268redirectLocally :: (PostBuild t m) => [segment] -> m (Event t [segment])
Reflex/Dom/RouteWriter.hs → Reflex/Dom/Routing/Writer.hsrenamed+15−7
@@ -9,7 +9,7 @@
9{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE UndecidableInstances #-}
10{-# LANGUAGE UndecidableInstances #-}
11
11
12−module Reflex.Dom.RouteWriter where
12+module Reflex.Dom.Routing.Writer where
13
13
14import Control.Lens (Rewrapped, Wrapped (..), iso)
14import Control.Lens (Rewrapped, Wrapped (..), iso)
15import Control.Monad.Exception (MonadAsyncException,
15import Control.Monad.Exception (MonadAsyncException,
@@ -20,7 +20,6 @@ import Control.Monad.Reader
20import Control.Monad.Ref
20import Control.Monad.Ref
21import qualified Control.Monad.State.Strict as StrictState
21import qualified Control.Monad.State.Strict as StrictState
22import Data.Coerce (coerce)
22import Data.Coerce (coerce)
23−import Foreign.JavaScript.TH
24import Language.Javascript.JSaddle (MonadJSM)
23import Language.Javascript.JSaddle (MonadJSM)
25import Reflex
24import Reflex
26import Reflex.Dom.Builder.Class
25import Reflex.Dom.Builder.Class
@@ -28,7 +27,7 @@ import Reflex.Dom.Builder.Immediate
28import Reflex.Dom.Core
27import Reflex.Dom.Core
29import Reflex.Host.Class
28import Reflex.Host.Class
30
29
31−import Reflex.Dom.NestedRoute
30+import Reflex.Dom.Routing.Nested
32
31
33
32
34class (Reflex t, Monad m) => RouteWriter t segment m | m -> segment, m -> t where
33class (Reflex t, Monad m) => RouteWriter t segment m | m -> segment, m -> t where
@@ -43,6 +42,11 @@ newtype RouteWriterT t segment m a = RouteWriterT { unRouteWriterT :: EventWrite
43instance (MonadWidget t m) => RouteWriter t segment (RouteWriterT t segment m) where
42instance (MonadWidget t m) => RouteWriter t segment (RouteWriterT t segment m) where
44 tellRoute = RouteWriterT . tellEvent
43 tellRoute = RouteWriterT . tellEvent
45
44
45+deriving instance DomRenderHook t m => DomRenderHook t (RouteWriterT t segment m)
46+
47+instance (Prerender t m, Monad m, Reflex t) => Prerender t (RouteWriterT t segment m) where
48+ type Client (RouteWriterT t segment m) = RouteWriterT t segment (Client m)
49+ prerender (RouteWriterT a) (RouteWriterT b) = RouteWriterT $ prerender a b
46
50
47instance Requester t m => Requester t (RouteWriterT t segment m) where
51instance Requester t m => Requester t (RouteWriterT t segment m) where
48 type Request (RouteWriterT t segment m) = Request m
52 type Request (RouteWriterT t segment m) = Request m
@@ -91,18 +95,22 @@ instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RouteWrite
91 placeRawElement = lift . placeRawElement
95 placeRawElement = lift . placeRawElement
92 wrapRawElement e = lift . wrapRawElement e
96 wrapRawElement e = lift . wrapRawElement e
93
97
98+instance (Monad m, NotReady t m) => NotReady t (RouteWriterT t segment m)
99+
94deriving instance MonadReader r m => MonadReader r (RouteWriterT t segment m)
100deriving instance MonadReader r m => MonadReader r (RouteWriterT t segment m)
95
101
96instance RouteWriter t segment m => RouteWriter t segment (EventWriterT t w m) where
102instance RouteWriter t segment m => RouteWriter t segment (EventWriterT t w m) where
97 tellRoute = lift . tellRoute
103 tellRoute = lift . tellRoute
98−
99instance EventWriter t w m => EventWriter t w (RouteWriterT t segment m) where
104instance EventWriter t w m => EventWriter t w (RouteWriterT t segment m) where
100 tellEvent = lift . tellEvent
105 tellEvent = lift . tellEvent
101
106
107+instance RouteWriter t segment m => RouteWriter t segment (DynamicWriterT t w m) where
108+ tellRoute = lift . tellRoute
109+instance DynamicWriter t w m => DynamicWriter t w (RouteWriterT t segment m) where
110+ tellDyn = lift . tellDyn
111+
112+
102instance HasDocument m => HasDocument (RouteWriterT t segment m)
113instance HasDocument m => HasDocument (RouteWriterT t segment m)
103−instance HasJSContext m => HasJSContext (RouteWriterT t segment m) where
104− type JSContextPhantom (RouteWriterT t segment m) = JSContextPhantom m
105− askJSContext = RouteWriterT askJSContext
106#ifndef ghcjs_HOST_OS
114#ifndef ghcjs_HOST_OS
107instance MonadJSM m => MonadJSM (RouteWriterT segment t m)
115instance MonadJSM m => MonadJSM (RouteWriterT segment t m)
108#endif
116#endif
reflex-dom-nested-routing.cabal+7−3
@@ -1,5 +1,5 @@
1name: reflex-dom-nested-routing
1name: reflex-dom-nested-routing
2−version: 0.0.1
2+version: 0.0.3
3synopsis: Nested client-side routing for Reflex-DOM
3synopsis: Nested client-side routing for Reflex-DOM
4description: See README at <https://github.com/3noch/reflex-dom-nested-routing#readme>
4description: See README at <https://github.com/3noch/reflex-dom-nested-routing#readme>
5category: Web
5category: Web
@@ -9,6 +9,10 @@ license: BSD3
9license-file: LICENSE
9license-file: LICENSE
10build-type: Simple
10build-type: Simple
11cabal-version: >= 1.10
11cabal-version: >= 1.10
12+extra-source-files:
13+ CHANGELOG.md
14+ README.md
15+
12
16
13library
17library
14 hs-source-dirs: .
18 hs-source-dirs: .
@@ -34,6 +38,6 @@ library
34 , text
38 , text
35 , uri-bytestring
39 , uri-bytestring
36 exposed-modules:
40 exposed-modules:
37− Reflex.Dom.NestedRoute
41+ Reflex.Dom.Routing.Nested
38− Reflex.Dom.RouteWriter
42+ Reflex.Dom.Routing.Writer
39 default-language: Haskell2010
43 default-language: Haskell2010