route generates unintuitive default link for first entry

[benjaminweb]

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}

module Table where

import qualified Data.Text as T
import Data.Text (Text)
import Web.Hyperbole

router :: (Hyperbole :> es) => AppRoute -> Eff es Response
router Main = page $ centralPage Nothing
router (ResultRequested x) = page $ centralPage (Just x)
router Query = do
  p <- reqParam "key"
  view $ el (pad 20) $ do
    text "key: "
    text p

data AppRoute = Main | ResultRequested ResultVariant | Query deriving (Generic, Eq, Route)

data Central = Central
  deriving (Show, Read, ViewId)

data CentralAction = ChangeSelectedTo Selected
  deriving (Show, Read, ViewAction)

data Selected = A | B | C deriving (Show, Eq, Read)

instance HyperView Central where
  type Action Central = CentralAction
  type Require Central = '[Presets, Results]

central :: Central -> CentralAction -> Eff es (View Central ())
central _ (ChangeSelectedTo x) = pure $ centralView x Nothing

centralPage :: (Hyperbole :> es) => Maybe ResultVariant -> Page es '[Central, Presets, Results]
centralPage v = do
  -- message listens for any actions that the centralView triggers
  handle central $ handle presets $ handle results $ load $ do
    pure $ do
      el bold "Message Page"
      hyper Central $ centralView A v

createNavButton :: Selected -> Selected -> View Central ()
createNavButton currentSelected changeTo = button (ChangeSelectedTo changeTo) btnStyle $ text $ T.pack $ show changeTo
  where btnStyle | currentSelected == changeTo = Style.btn' Colors.Secondary
                 | otherwise = Style.btn' Colors.Primary

centralView :: Selected -> Maybe ResultVariant -> View Central ()
centralView s v = do
  col (border 3 . pad 10 . gap 10) $ do
    row (gap 10) $ do
      el_ $ text "Please select group:"
      createNavButton s A 
      createNavButton s B
      createNavButton s C
    col (border 3 . pad 10 . gap 10) $ do
      hyper Presets $ presetsView s
      hyper Results $ resultsView v

data Presets = Presets
  deriving (Show, Read, ViewId)

data PresetsAction = View Selected deriving (Show, Read, ViewAction)

instance HyperView Presets where
  type Action Presets = PresetsAction

presets :: (Hyperbole :> es) => Presets -> PresetsAction -> Eff es (View Presets ())
presets _ (View s) = pure $ presetsView s

presetGroup :: [ResultVariant] -> View Presets ()
presetGroup = foldl1 (>>) . map presetTarget

presetTarget :: ResultVariant -> View Presets ()
presetTarget x = target Results $ button (ViewResults $ Just x) Style.btn $ text $ T.pack $ show x
--presetTarget x = route (ResultRequested x) id $ text $ T.pack $ show x

presetsView :: Selected -> View Presets ()
presetsView s = do
  col (border 3 . pad 30 . gap 30) $ do
    text $ "presetsView: viewing details for " `T.append` T.pack (show s)
    col (pad 10 . gap 10) $ case s of
      A -> presetGroup [Result1]
      B -> presetGroup [Result1, Result3]
      C -> presetGroup [Result4, Result5, Result6]

data Results = Results
  deriving (Show, Read, ViewId)

data ResultVariant = Result1 | Result2 | Result3 | Result4 | Result5 | Result6 deriving (Show, Eq, Read, Generic, Route)

data ResultsAction = ViewResults (Maybe ResultVariant) deriving (Show, Read, ViewAction)

instance HyperView Results where
  type Action Results = ResultsAction

results :: (Hyperbole :> es) => Results -> ResultsAction -> Eff es (View Results ())
results _ (ViewResults x) = pure $ resultsView x

resultsView :: Maybe ResultVariant -> View Results ()
resultsView Nothing = col (border 3 . pad 10) $ el_ $ text "no results!"
resultsView (Just x) = col (border 3 . pad 10) $ do
                        el_ $ text "results"
                        route (ResultRequested x) id $ "link to share" -- yields "/resultrequested" for Route1 where "/resultrequested/Route1" would be expected
                        row (border 1) $ el_ $ text "…buttons for filtering"
                        text $ case x of
                          Result1 -> "one short result"
                          Result2 -> "a different result"
                          Result3 -> "this is a special result"
                          Result4 -> "THIS IS NUUUMBER FOOOOUUUUR!"
                          Result5 -> "give me high five"
                          Result6 -> "and no. 6"

• route (ResultRequested x) id $ "link to share" yields "/resultrequested" for Route1 where "/resultrequested/Route1" would be expected (for any other like Route2 "resultrequested/Route2" are generated
• "/resultrequested/Route1" still works

[seanhess]

Maybe you can help me out with a design problem here. I wanted the ability for a user to define subroutes, but also a "main" route:

data MyRoute
  = Main
  | One
  | Two
  deriving (Generic, Route)

So the user can visit / and get Main, /one for One, etc. As you've noticed, /main still works.

The route function assumes you want to use this pattern. Take a look at the definition of routePath: it's doing this deliberately https://github.com/seanhess/hyperbole/blob/main/src/Web/Hyperbole/Route.hs#L52. I've found I use this pattern more often than I want to avoid it, and have all the constructors be peers.

Do you have any suggestions? One alternative would be to NOT assume the user wants this and require them to specify defRoute that the user would need to make the presence of a default route explicit:

-- This would work as you expect, with /one, /two, and /three generated
data MyRoute
  = One
  | Two
  | Three
  deriving (Generic, Route)

-- This would work like the library does now
data MyRoute
  = Main
  | One
  | Two
  deriving (Generic)
instance Route MyRoute where
  defRoute = Just Main -- we change this to a maybe to make it optional

Let me know your thoughts!

[benjaminweb]

Hm, my situation is that Main and ResultRequested ResultVariant end up as / and /ResultRequested. The first is ok the second not. For me it would be solved once any variant carrying another type should have that used always explicitly.

How about defining reute overrides, something like a rewrite engine on http servers? This could be as simple as a list of tuples on the user side. More versatile and more explicit hence less surprising behaviour.

What do you think?

[seanhess]

Let me make sure I understand

data AppRoute = Main | ResultRequested ResultVariant | Query deriving (Generic, Eq, Route)
data ResultVariant = Result1 | Result2 | Result3 | Result4 | Result5 | Result6 deriving (Show, Eq, Read, Generic, Route)

You want the following?

routeUrl Main -- "/"
routeUrl (ResultRequested Result1) -- "/resultrequested/result1"
routeUrl (ResultRequested Result2) -- "/resultrequested/result2"

Whereas, right now it does this

routeUrl Main -- "/"
routeUrl (ResultRequested Result1) -- "/resultrequested/"
routeUrl (ResultRequested Result2) -- "/resultrequested/result2"

Is that right?

You can make it behave pretty much any way you want by implementing the class methods of Route. The generics implementation is just there for convenience.

import Web.Hyperbole.Route (GenRoute(..))
import GHC.Generics (from)

data ResultVariant = Result1 | Result2 | Result3 | Result4 | Result5 | Result6 deriving (Show, Eq, Read, Generic)

-- this will override the default implementation, and make sure each constructor is spelled out fully, even the "main" one. 
instance Route ResultVariant where
  routePath Result1 = ["result1"]
  routePath a = genPaths $ from a

Does that give you what you want? Or do you also think the default implementation should change?

[benjaminweb]

Correct assumptions!

For me (subjective, of course), the default (for any types with children like (ResultRequested) should be /resultrequested/resultX. However Main being written as "/" is fine by me. So, simply put, I should explicitly write the override if I want to have sth. being dropped that is unexpected for me.

(I wouldn't use this if there would be #32 with #29 implemented) But actually, the real thing for me is encoding a record type into a query arg back and forth. There we don't have that problem at all, because everything is explicit.

[seanhess]

Nested routes often need "Main" pages too:

data AppRoute = AppRoot | Users UserRoute | Posts PostRoute deriving (Generic, Route)
data UserRoute = AllUsers | User UserId deriving (Generic, Route)
data PostRoute = AllPosts | Post PostId deriving (Generic, Route)

This is really a discussion about what the default behavior should be. I agree that the current implementation has more magic than doing it the other way.

Remember that routes still resolve to the full name: so in the above, both /users and /users/allusers will resolve to Users AllUsers. The only thing that changes is the url the user sees. Is there a practical limitation I'm not understanding or is it only cosmetic in your use case?

Would you think it was a better design if it worked like you expected, but in the above (very common) use case, the user had to specify the main route? The above would require:

data AppRoute = AppRoot | Users UserRoute | Posts PostRoute deriving (Generic)
instance Route AppRoute where
  defRoute = Just AppRoot

data UserRoute = AllUsers | User UserId deriving (Generic)
instance Route UserRoute where
  defRoute = Just AllUsers

data PostRoute = AllPosts | Post PostId deriving (Generic)
instance Route PostRoute where
  defRoute = Just AllPosts

[benjaminweb]

Practical limitation? Hm. Maybe readability for the user. And if certain entities change, the URL might no longer be up to date. Hm, how about a switch DefaultToShortName | DefaultToFullRouteNames? that needs to be provided? In doubt, the user can look it up what each setting does.

I resorted to the route only because the QueryArgs isn't batteries-included yet. So, please don't over-invest in me abusing the route functionality for a scenario it might not be a good fit for :).

[seanhess]

I'm confused what you're recommending with your example, can you explain by showing the type and what you would expect the routes to be?

[benjaminweb]

Does this help?

routeUrl DefaultToShortName Main -- "/"
routeUrl DefaultToShortName (ResultRequested Result1) -- "/resultrequested/"
routeUrl DefaultToShortName (ResultRequested Result2) -- "/resultrequested/result2"

routeUrl DefaultToShortName Main -- "/"
routeUrl DefaultToFullRouteNames (ResultRequested Result1) -- "/resultrequested/result1"
routeUrl DefaultToFullRouteNames (ResultRequested Result2) -- "/resultrequested/result2"

[seanhess]

Oh I see. Thanks. Hm..... I don't like needing to specify the path each time you use it.

Let's make it explicit. The new behavior will be to NOT generate a default "base" route for a type. It must be specified manually:

data AppRoute = AppRoot | Users UserRoute | Posts PostRoute deriving (Generic)
instance Route AppRoute where
  baseRoute = Just AppRoot

data UserRoute = AllUsers | User UserId deriving (Generic)
instance Route UserRoute where
  baseRoute = Just AllUsers

If omitted, it expects full route names

data PostRoute = AllPosts | Post PostId deriving (Generic, Route) 

-- AllPosts -> "/allposts"
-- Post 3 -> "/post/3"
-- "/" -> Matches Nothing