How to optionally capture a path segment in Haskell servant?

Question

I need to introduce a internalization in my servant app in a backward compatible manner. I want to have the language code as an optional path segment. If the very first path segment is from a known list of language codes, that language is used, else it defaults to Nothing (which the handler/server would interpret as some default language).

/some/path => myHandler Nothing
/en/some/path => myHanddler (Just "en")
/fr/some/path => myHandler (Just "fr")

To avoid having to write the following boilerplate...

• Each endpoint will have two endpoints: one with the language code segment, and one without
• Therefore, the server/handler will also need to have two variants -- one with language code and one without

...I wanted to come up with a servant combinator that "peeks" at head $ pathInfo req and it if looks like a language-code, it captures it, else it passes along Nothing to the sub-server.

I came up with the following, but this is not working, because it always expects pathSegment to be present. It is not capturing it on an optional basis.

data HostWithLocale = HostWithLocale

instance (HasServer api context) => HasServer (HostWithLocale :> api) context where
  type ServerT (HostWithLocale :> api) m = (Hostname, Maybe LanguageCode) -> ServerT api m
  
  hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy api) pc nt . s  

  route _ context server = 
    CaptureRouter [hint] $ route (Proxy :: Proxy api) context subserver
    where
      hint = CaptureHint "language" (typeRep (Proxy :: Proxy (Hostname, Maybe LanguageCode)))
      subserver = addCapture server $ \pathSegment -> withRequest $ \req -> 
        case DL.lookup (fromString "Host") (requestHeaders req) of
          Nothing -> 
            delayedFail err406
          Just hname -> 
            if Prelude.not (isWhiteListedDomain hname)
              then delayedFail err406
              else if pathSegment `DL.elem` knownLanguageCodes
                then pure $ (toS hname, Just $ LanguageCode pathSegment)
                else pure $ (toS hname, Nothing)

isWhiteListedDomain :: C8.ByteString -> Bool
isWhiteListedDomain = undefined 
    
knownLanguageCodes :: [Text]
knownLanguageCodes = undefined

Answer 1

Therefore, the server/handler will also need to have two variants -- one with language code and one without

Those two variants can be defined without much duplication, and without having to define new HasServer instances.

Imagine that you have a SomeApi type that corresponds to a Servant API definition. It might be very complex, have many routes, whatever. The type of a value that can serve that API will be Server SomeApi.

Suppose that now we define this API that captures a language path segment:

type SomeApiI18n = Capture "lang" Text :> SomeApi

That API can be served by values of type Server SomeApiI18n. But, if we expand the Server type family application a little, that type will be equivalent to Text -> Server SomeApi.

Now suppose we have a value someServerI18n of type Text -> Server SomeApi and want to serve SomeApi (the non-localized version) with it. How? Very easy, we simply apply a default language:

someServer' :: Server SomeApi
someServer' = someServerI18n "en"

Now, suppse you have a combined API like

type FullApi = SomeApi :<|> SomeApiI18n

It can be served like this:

fullApiServer :: Server FullApi
fullApiServer = someServerI18N "en" :<|> someServerI18N

No need to tweak every route in SomeApi, or to define two completely different server implementations.