@@ -7,15 +7,11 @@
77{-# LANGUAGE FlexibleContexts #-}
88{-# LANGUAGE FlexibleInstances #-}
99{-# LANGUAGE GADTs #-}
10−{-# LANGUAGE KindSignatures #-}
1110{-# LANGUAGE LambdaCase #-}
12−{-# LANGUAGE MultiParamTypeClasses #-}
1311{-# LANGUAGE OverloadedStrings #-}
1412{-# LANGUAGE PatternSynonyms #-}
1513{-# LANGUAGE RankNTypes #-}
1614{-# LANGUAGE ScopedTypeVariables #-}
17−{-# LANGUAGE TemplateHaskell #-}
18−{-# LANGUAGE TupleSections #-}
1915{-# LANGUAGE TypeFamilies #-}
2016{-# LANGUAGE TypeOperators #-}
2117{-# LANGUAGE ViewPatterns #-}
@@ -53,10 +49,8 @@ module Obelisk.Route.Frontend
5349 , runRouteToUrlT
5450 , mapRouteToUrlT
5551 , routeLink
56− , routeLinkScrollToTop
5752 , routeLinkDynAttr
5853 , dynRouteLink
59− , dynRouteLinkScrollToTop
6054 , adaptedUriPath
6155 , setAdaptedUriPath
6256 ) where
@@ -515,19 +509,7 @@ runRouteViewT routeEncoder switchover useHash a = do
515509-- | A link widget that, when clicked, sets the route to the provided route. In non-javascript
516510-- contexts, this widget falls back to using @href@s to control navigation
517511routeLink
518− :: forall t m a route.
519− ( DomBuilder t m
520− , RouteToUrl route m
521− , SetRoute t route m
522− )
523− => route -- ^ Target route
524− -> m a -- ^ Child widget
525− -> m a
526−routeLink r w = snd <$> routeLinkImpl r w
527−
528−-- | Like 'routeLink' but scrolls to the top of the page.
529−routeLinkScrollToTop
530− :: forall js t m a route.
512+ :: forall t m a route js.
531513 ( DomBuilder t m
532514 , RouteToUrl route m
533515 , SetRoute t route m
@@ -536,11 +518,12 @@ routeLinkScrollToTop
536518 => route -- ^ Target route
537519 -> m a -- ^ Child widget
538520 -> m a
539−routeLinkScrollToTop r w = do
521+routeLink r w = do
540522 (e, a) <- routeLinkImpl r w
541523 scrollToTop e
542524 return a
543525
526+-- | Raw implementation of 'routeLink'. Does not scroll to the top of the page on clicks.
544527routeLinkImpl
545528 :: forall t m a route.
546529 ( DomBuilder t m
@@ -559,14 +542,14 @@ routeLinkImpl r w = do
559542 setRoute $ r <$ domEvent Click e
560543 return (domEvent Click e, a)
561544
562−scrollToTop :: (Prerender js t m, Monad m) => Event t () -> m ()
545+scrollToTop :: forall m t js. (Prerender js t m, Monad m) => Event t () -> m ()
563546scrollToTop e = prerender_ blank $ performEvent_ $ ffor e $ \_ -> liftJSM $ DOM.currentWindow >>= \case
564− Nothing -> pure ()
565− Just win -> Window.scrollTo win 0 0
547+ Nothing -> pure ()
548+ Just win -> Window.scrollTo win 0 0
566549
567−-- | Like 'dynRouteLink' but scrolls to the top of the page.
568−dynRouteLinkScrollToTop
569− :: forall js t m a route.
550+-- | Like 'routeLinkDynAttr' but without custom attributes.
551+dynRouteLink
552+ :: forall t m a route js.
570553 ( DomBuilder t m
571554 , PostBuild t m
572555 , RouteToUrl route m
@@ -576,11 +559,12 @@ dynRouteLinkScrollToTop
576559 => Dynamic t route -- ^ Target route
577560 -> m a -- ^ Child widget
578561 -> m a
579−dynRouteLinkScrollToTop r w = do
562+dynRouteLink r w = do
580563 (e, a) <- dynRouteLinkImpl r w
581564 scrollToTop e
582565 return a
583566
567+-- | Raw implementation of 'dynRouteLink'. Does not scroll to the top of the page on clicks.
584568dynRouteLinkImpl
585569 :: forall t m a route.
586570 ( DomBuilder t m
@@ -598,26 +582,32 @@ dynRouteLinkImpl dr w = do
598582 & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
599583 & elementConfig_modifyAttributes .~ er
600584 (e, a) <- element "a" cfg w
601− setRoute $ tag (current dr) $ domEvent Click e
602− return (domEvent Click e, a)
585+ let clk = domEvent Click e
586+ setRoute $ tag (current dr) clk
587+ return (clk, a)
603588
604−-- | Like 'routeLinkDynAttr' but without custom attributes.
605−dynRouteLink
606− :: forall t m a route.
589+-- | An @a@-tag link widget that, when clicked, sets the route to current value of the
590+-- provided dynamic route. In non-JavaScript contexts the value of the dynamic post
591+-- build is used so the link still works like 'routeLink'.
592+routeLinkDynAttr
593+ :: forall t m a route js.
607594 ( DomBuilder t m
608595 , PostBuild t m
609596 , RouteToUrl (R route) m
610597 , SetRoute t (R route) m
598+ , Prerender js t m
611599 )
612− => Dynamic t (R route) -- ^ Target route
600+ => Dynamic t (Map AttributeName Text) -- ^ Attributes for @a@ element. Note that if @href@ is present it will be ignored
601+ -> Dynamic t (R route) -- ^ Target route
613602 -> m a -- ^ Child widget of the @a@ element
614603 -> m a
615−dynRouteLink = routeLinkDynAttr mempty
604+routeLinkDynAttr dAttr dr w = do
605+ (e, a) <- routeLinkDynAttrImpl dAttr dr w
606+ scrollToTop e
607+ return a
616608
617−-- | An @a@-tag link widget that, when clicked, sets the route to current value of the
618−-- provided dynamic route. In non-JavaScript contexts the value of the dynamic post
619−-- build is used so the link still works like 'routeLink'.
620−routeLinkDynAttr
609+-- | Raw implementation of 'routeLinkDynAttr'. Does not scroll to the top of the page on clicks.
610+routeLinkDynAttrImpl
621611 :: forall t m a route.
622612 ( DomBuilder t m
623613 , PostBuild t m
@@ -627,16 +617,17 @@ routeLinkDynAttr
627617 => Dynamic t (Map AttributeName Text) -- ^ Attributes for @a@ element. Note that if @href@ is present it will be ignored
628618 -> Dynamic t (R route) -- ^ Target route
629619 -> m a -- ^ Child widget of the @a@ element
630− -> m a
631−routeLinkDynAttr dAttr dr w = do
620+ -> m (Event t (), a)
621+routeLinkDynAttrImpl dAttr dr w = do
632622 enc <- askRouteToUrl
633623 er <- dynamicAttributesToModifyAttributes $ zipDynWith (<>) (("href" =:) . enc <$> dr) dAttr
634624 let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))
635625 & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (\_ -> preventDefault)
636626 & elementConfig_modifyAttributes .~ er
637627 (e, a) <- element "a" cfg w
638− setRoute $ tag (current dr) $ domEvent Click e
639− return a
628+ let clk = domEvent Click e
629+ setRoute $ tag (current dr) clk
630+ return (clk, a)
640631
641632-- On ios due to sandboxing when loading the page from a file adapt the
642633-- path to be based on the hash.