How do I create a typeclass that will account for different container types?

Question

I've been struggling with this issue for an hour or two already, I'm finding it difficult in my mind to translate the mental concept into actual code. It feels like I'm missing some knowledge relating to typeclasses - but I'm not sure what.

So essentially we have the following code:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE AllowAmbiguousTypes #-}

module Routes where

data RouteUrl a = Dashboard
              | CreatePost
              | ListPost
              | EditPost a
              | DeletePost a
              | Register
              | Login deriving Show

data PublicUrl = PublicUrl (RouteUrl Int)
data PlaceHolderUrl = PlaceHolderUrl (RouteUrl String)

data UrlSum = UrlPub PublicUrl | UrlPla PlaceHolderUrl

getUrl :: UrlSum -> String
getUrl (UrlPub (PublicUrl (Dashboard))) =       "/dashboard"
getUrl (UrlPla (PlaceHolderUrl (Dashboard))) =  "/dashboard"
getUrl (UrlPub (PublicUrl (EditPost x))) =      "/editpost/" ++ show x
getUrl (UrlPla (PlaceHolderUrl (EditPost x))) = "/editpost/(abcxyz)" ++ show x

The above works fine, but I'm trying to find a way to avoid the duplication of the "/dashboard", "/editpost/..." parts.

The only difference in output should be that for PlaceHolderUrl we should prepend (abcxyz) to the parameter.

So in my mental model I'm just thinking "look at the outer type (PublicUrl or PlaceHolderUrl), and just use the appropriate function assigned for that type" I was thinking I could just make something along the lines of:

getUrl' :: (RenderUrlComponent u b) Int => u -> String
getUrl' u = case (getRouteUrl u) of
  Dashboard -> "/dashboard"
  (EditPost x) -> "/editpost/" ++ renderUrlComponent u

class RenderUrlComponent a b where
  renderUrlComponent :: a -> String
  getRoute :: a -> RouteUrl b

instance RenderUrlComponent PublicUrl Int where
  renderUrlComponent publicUrl = getRoute publicUrl :: RouteUrl Int
  getRoute (PublicUrl x) = x

However in addition to the above having the following error:

• Expecting one fewer arguments to ‘RenderUrlComponent u b’
  Expected kind ‘* -> Constraint’,
    but ‘RenderUrlComponent u b’ has kind ‘Constraint’
• In the type signature:
    getUrl' :: (RenderUrlComponent u b) Int => u -> String    | 26 |

I can't figure out how I would get the Int out of getRoute publicUrl :: RouteUrl Int, without having to resort to pattern matching, in which case I'm back with the problem I started with.

---

It seems I'm looking for something along the lines of:

x is an instance for y, if it is contained in z.

Answer 1

Looking back it seems I over complicated things, however just for fun I've managed to get it working with typeclasses, essentially it uses a phantom type and you also need to pass the RouteUrl to the parameter modifier function f, although it is ignored, the compiler can infer which instance to use...

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONs -Wno-incomplete-patterns #-}

module Routes where

data RouteUrl a b = Dashboard
              | CreatePost
              | ListPost
              | EditPost a
              | DeletePost a
              | Register
              | Login deriving Show

data PublicUrl
data PlaceHolderUrl
data NormalizedUrl

class Show a => RouteParam a b where
  f :: RouteUrl a b -> String -> String
  normalParam :: RouteUrl a b -> RouteUrl String NormalizedUrl
  normalParam (Dashboard) = Dashboard
  normalParam (CreatePost) = CreatePost
  normalParam (ListPost) = ListPost
  normalParam (EditPost x ) = EditPost $ show x
  normalParam (DeletePost x ) = DeletePost $ show x
  normalParam (Register) = Register
  normalParam (Login) = Login

instance RouteParam Int PublicUrl where
  f _ = id

instance RouteParam String PlaceHolderUrl where
  f _ = ("(abcxyz)" ++)

renderUrl :: RouteParam a b => RouteUrl a b -> String
renderUrl r = case normalParam  r of
      Dashboard -> "/dashboard/"
      EditPost x -> "/editpost/" ++ (f r x)

renderPublicUrl:: RouteUrl Int PublicUrl -> String
renderPublicUrl r = renderUrl r

renderPlaceHolderUrl :: RouteUrl String PlaceHolderUrl -> String
renderPlaceHolderUrl r = renderUrl r

Answer 2

Just make a helper function that abstracts out the commonality, no need (or justification) for a class here.

module Routes where

data RouteUrl a = Dashboard
              | CreatePost
              | ListPost
              | EditPost a
              | DeletePost a
              | Register
              | Login deriving Show

data PublicUrl = PublicUrl (RouteUrl Int)
data PlaceHolderUrl = PlaceHolderUrl (RouteUrl String)

data UrlSum = UrlPub PublicUrl | UrlPla PlaceHolderUrl

getUrlRU :: (Show a) => (String -> String) -> RouteUrl a -> String
getUrlRU prefix ru =
  case ru of
    Dashboard  -> "/dashboard"
    EditPost x -> "/editpost/" ++ prefix (show x)
    ....

getUrl :: UrlSum -> String
getUrl (UrlPub (PublicUrl x)) = getUrlRU id x
getUrl (UrlPla (PlaceHodlerUrl x)) = getUrlRU ("(abcxyz)" ++) x

You don't have to pass a function if you don't want to, you could make prefix a string and prefix ++ (show x). Passing a function gives you a bit of flexibility which might be helpful if you were over-simplifying your question somehow.