git.iko.soy/obelisk
on eed1df6 help sign in
7ad33cb
swap
4 ahead, 257 behind
4 files changed+50−17
since splitsnapshots
unifiedsplit
dep/reflex-platform/default.nix+1−7 dep/reflex-platform/github.json+3−3 dep/reflex-platform/thunk.nix+9 lib/route/src/Obelisk/Route/Frontend.hs+37−7
dep/reflex-platform/default.nix+1−7
@@ -1,8 +1,2 @@
11# DO NOT HAND-EDIT THIS FILE
2−let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
3− if !fetchSubmodules && !private then builtins.fetchTarball {
4− url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
5− } else (import <nixpkgs> {}).fetchFromGitHub {
6− inherit owner repo rev sha256 fetchSubmodules private;
7− };
8−in import (fetch (builtins.fromJSON (builtins.readFile ./github.json)))
2+import (import ./thunk.nix)
dep/reflex-platform/github.json+3−3
@@ -1,8 +1,8 @@
11{
22 "owner": "reflex-frp",
33 "repo": "reflex-platform",
4− "branch": "release/0.5.3.0",
4+ "branch": "ts-reflex-dom-test-selenium",
55 "private": false,
6− "rev": "9779ea3b4c87fdc971057c561262696d5e9b1847",
7− "sha256": "0v87ilal9355xwz8y9m0zh14pm9c0f7pqch0854kkj92ybc5l62q"
6+ "rev": "d3a3bb4381244ba83f3e662aebb121b0225ce76b",
7+ "sha256": "1nhwzl3l20lsyjcsm28mvacbn9dxab8xn8fynnlpwaymm4a37639"
88}
dep/reflex-platform/thunk.nixnew file+9
@@ -0,0 +1,9 @@
1+# DO NOT HAND-EDIT THIS FILE
2+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
3+ if !fetchSubmodules && !private then builtins.fetchTarball {
4+ url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
5+ } else (import <nixpkgs> {}).fetchFromGitHub {
6+ inherit owner repo rev sha256 fetchSubmodules private;
7+ };
8+ json = builtins.fromJSON (builtins.readFile ./github.json);
9+in fetch json
lib/route/src/Obelisk/Route/Frontend.hs+37−7
@@ -49,6 +49,7 @@ module Obelisk.Route.Frontend
4949 , runRouteToUrlT
5050 , mapRouteToUrlT
5151 , routeLink
52+ , routeLinkAttr
5253 , routeLinkDynAttr
5354 , dynRouteLink
5455 , adaptedUriPath
@@ -72,6 +73,7 @@ import Data.Coerce
7273import Data.Dependent.Sum (DSum (..))
7374import Data.GADT.Compare
7475import Data.Map (Map)
76+import qualified Data.Map as Map
7577import Data.Monoid
7678import Data.Proxy
7779import Data.Text (Text)
@@ -519,10 +521,30 @@ routeLink
519521 -> m a -- ^ Child widget
520522 -> m a
521523routeLink r w = do
522− (e, a) <- routeLinkImpl r w
524+ (e, a) <- routeLinkImpl mempty r w
523525 scrollToTop e
524526 return a
525527
528+-- | Like 'routeLink', but takes additional attributes as argument.
529+--
530+routeLinkAttr
531+ :: forall t m a route js.
532+ ( DomBuilder t m
533+ , RouteToUrl route m
534+ , SetRoute t route m
535+ , Prerender js t m
536+ )
537+ => Map AttributeName Text -- ^ Additional attributes
538+ -> route -- ^ Target route
539+ -> m a -- ^ Child widget
540+ -> m a
541+routeLinkAttr attrs r w = do
542+ (e, a) <- routeLinkImpl attrs r w
543+ let
544+ targetBlank = Map.lookup "target" attrs == Just "_blank"
545+ when (not targetBlank) $ scrollToTop e
546+ return a
547+
526548-- | Raw implementation of 'routeLink'. Does not scroll to the top of the page on clicks.
527549routeLinkImpl
528550 :: forall t m a route.
@@ -530,16 +552,24 @@ routeLinkImpl
530552 , RouteToUrl route m
531553 , SetRoute t route m
532554 )
533− => route -- ^ Target route
555+ => Map AttributeName Text
556+ -> route -- ^ Target route
534557 -> m a -- ^ Child widget
535558 -> m (Event t (), a)
536−routeLinkImpl r w = do
559+routeLinkImpl attrs r w = do
537560 enc <- askRouteToUrl
538− let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
539− & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
540− & elementConfig_initialAttributes .~ "href" =: enc r
561+ let
562+ -- If targetBlank == True, the link will be opened in another page. In that
563+ -- case, we don't prevent the default behaviour, and we don't need to
564+ -- setRoute.
565+ targetBlank = Map.lookup "target" attrs == Just "_blank"
566+ cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
567+ & elementConfig_initialAttributes .~ ("href" =: enc r <> attrs)
568+ & (if targetBlank
569+ then id
570+ else elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault))
541571 (e, a) <- element "a" cfg w
542− setRoute $ r <$ domEvent Click e
572+ when (not targetBlank) $ setRoute $ r <$ domEvent Click e
543573 return (domEvent Click e, a)
544574
545575scrollToTop :: forall m t js. (Prerender js t m, Monad m) => Event t () -> m ()