Using type safe routes with persistent datatypes in snap

Question

I have a Snap application using Persistent for storage and I'm trying to generate type safe routes for data types defined in Persistent. I'm using the snap-web-routes package:.

I have the following Template Haskell function that creates the data type of Group and GroupId:

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
  Group
    name T.Text
    deriving Show
|]

In my Application.hs I have:

data AppUrl = AddLink GroupId deriving (Eq, Show, Read, Generic)

The doc's suggest that:

instance PathInfo AppUrl

is all i need to do given the Generic derivation above however this blows up with

No instance for (PathInfo (KeyBackend SqlBackend Group))
      arising from a use of ‘Web.Routes.PathInfo.$gdmtoPathSegments’

My assumption is that this error indicates that Haskell does not know how to auto create the instance definition with Persistent's data types.

My next attempt was to manually define the instance:

instance PathInfo AppUrl where
  toPathSegments   (AddLink groupId) = "add-link" : toPathPiece groupId : []
  fromPathSegments (x:y:[]) = ????

I can't seem to figure out how to construct the GroupId data type.

From Yesod's excellent Persistent tutorial I know that the datatype is defined as:

type GroupId = Key Group
newtype Key Group = GroupKey (BackendKey SqlBackend)

But then I run into a problem because BackendKey is not exposed so I can't import it and create my own instance. I can't seem to find a public API to create this data type in Persistent.

Answer 1

The documentation for SqlBackend shows that the associated datatype BackendKey is instanciated for SqlBackend as

data BackendKey SqlBackend = SqlBackendKey {
    unSqlBackendKey :: Int64
}

Which should be enough information to write your own PathInfo instance, along the lines of the following example:

{-# LANGUAGE TypeFamilies #-}

import Database.Persist.Sql
import Data.Int (Int64)

foo :: BackendKey SqlBackend -> Int64
foo (SqlBackendKey key) = key

bar :: Int64 -> BackendKey SqlBackend
bar = SqlBackendKey