git.iko.soy/obelisk
on master help sign in
Add support for Maybe routes
commiteb931ddff66536c1b7ccc6ad0347e7401a09f393 authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 12 Oct 2018, 21:52 (8 years ago) parent7f2dec1
2 files changed+49−2
compare with master
unifiedsplit
lib/route/src/Obelisk/Route.hs+25−2 lib/route/src/Obelisk/Route/Frontend.hs+24
lib/route/src/Obelisk/Route.hs+25−2
@@ -46,6 +46,8 @@ module Obelisk.Route
4646 , unsafeTshowEncoder
4747 , someConstEncoder
4848 , singlePathSegmentEncoder
49+ , maybeEncoder
50+ , maybeToEitherEncoder
4951 , justEncoder
5052 , nothingEncoder
5153 , isoEncoder
@@ -304,7 +306,28 @@ wrappedEncoder = isoEncoder $ from _Wrapped'
304306unwrappedEncoder :: (Wrapped a, Applicative check, Applicative parse) => Encoder check parse a (Unwrapped a)
305307unwrappedEncoder = isoEncoder _Wrapped'
306308
307−-- | Encodea a value by simply applying 'Just'
309+maybeToEitherEncoder :: (Applicative check, Applicative parse) => Encoder check parse (Maybe a) (Either () a)
310+maybeToEitherEncoder = unsafeMkEncoder $ EncoderImpl
311+ { _encoderImpl_encode = \case
312+ Nothing -> Left ()
313+ Just a -> Right a
314+ , _encoderImpl_decode = pure . \case
315+ Left _ -> Nothing
316+ Right a -> Just a
317+ }
318+
319+maybeEncoder
320+ :: ( MonadError Text check
321+ , Show a
322+ , Show b
323+ , check ~ parse
324+ )
325+ => Encoder check parse () b
326+ -> Encoder check parse a b
327+ -> Encoder check parse (Maybe a) b
328+maybeEncoder f g = shadowEncoder f g . maybeToEitherEncoder
329+
330+-- | Encode a value by simply applying 'Just'
308331justEncoder :: (Applicative check, MonadError Text parse) => Encoder check parse a (Maybe a)
309332justEncoder = prismEncoder _Just
310333
@@ -714,7 +737,7 @@ obeliskRouteEncoder appRouteSegment = pathComponentEncoder $ \r ->
714737obeliskRouteSegment :: forall check parse appRoute a.
715738 (MonadError Text check, MonadError Text parse)
716739 => ObeliskRoute appRoute a
717− -> (forall a. appRoute a -> SegmentResult check parse a)
740+ -> (forall b. appRoute b -> SegmentResult check parse b)
718741 -> SegmentResult check parse a
719742obeliskRouteSegment r appRouteSegment = case r of
720743 ObeliskRoute_App appRoute -> appRouteSegment appRoute
lib/route/src/Obelisk/Route/Frontend.hs+24
@@ -33,6 +33,9 @@ module Obelisk.Route.Frontend
3333 , mapRoutedT
3434 , subRoute
3535 , subRoute_
36+ , maybeRoute
37+ , maybeRoute_
38+ , maybeRouted
3639 , runRouteViewT
3740 , SetRouteT(..)
3841 , SetRoute(..)
@@ -164,6 +167,22 @@ subRoute :: (MonadFix m, MonadHold t m, GEq r, Adjustable t m) => (forall a. r a
164167subRoute f = factorRouted $ strictDynWidget $ \(c :=> r') -> do
165168 runRoutedT (f c) r'
166169
170+maybeRoute_ :: (MonadFix m, MonadHold t m, Adjustable t m) => m () -> RoutedT t r m () -> RoutedT t (Maybe r) m ()
171+maybeRoute_ n j = maybeRouted $ strictDynWidget_ $ \case
172+ Nothing -> n
173+ Just r -> runRoutedT j r
174+
175+maybeRoute :: (MonadFix m, MonadHold t m, Adjustable t m) => m a -> RoutedT t r m a -> RoutedT t (Maybe r) m (Dynamic t a)
176+maybeRoute n j = maybeRouted $ strictDynWidget $ \case
177+ Nothing -> n
178+ Just r -> runRoutedT j r
179+
180+{-
181+maybeRoute :: (MonadFix m, MonadHold t m, GEq r, Adjustable t m) => m a -> RoutedT t r m a -> RoutedT t (Maybe r) m a
182+maybeRoute f = factorRouted $ strictDynWidget $ \(c :=> r') -> do
183+ runRoutedT (f c) r'
184+-}
185+
167186dsumValueCoercion :: Coercion f g -> Coercion (DSum k f) (DSum k g)
168187dsumValueCoercion Coercion = Coercion
169188
@@ -175,6 +194,11 @@ factorRouted r = RoutedT $ ReaderT $ \d -> do
175194 d' <- factorDyn d
176195 runRoutedT r $ (coerceWith (dynamicCoercion $ dsumValueCoercion dynamicIdentityCoercion) d')
177196
197+maybeRouted :: (Reflex t, MonadFix m, MonadHold t m) => RoutedT t (Maybe (Dynamic t a)) m b -> RoutedT t (Maybe a) m b
198+maybeRouted r = RoutedT $ ReaderT $ \d -> do
199+ d' <- maybeDyn d
200+ runRoutedT r d'
201+
178202-- | WARNING: The input 'Dynamic' must be fully constructed when this is run
179203strictDynWidget :: (MonadSample t m, MonadHold t m, Adjustable t m) => (a -> m b) -> RoutedT t a m (Dynamic t b)
180204strictDynWidget f = RoutedT $ ReaderT $ \r -> do