Servant-like routing in PureScript without ordering requirements

README.md

Servant-like routing in PureScript without ordering requirements

With Servant-style routing, the ordering of endpoints in types must line up with handlers on the value level. Destructuring clients and link structures derived from a routing type cannot be done without introducing coupling to the ordering of the routing type.

This experiment tries to remove that ordering issue, by using named resources and methods on the type level, in combination with PureScript's records (constrained by RowCons) at the value level. The ordering no longer matter when we give handlers in a record. We could also implement link or client deriving functions that would extract specific clients based on a given name. All name checks are done at compile time.

Trout2.js

exports.unsafeGet = function (l) {
    return function (r) {
        return r[l];
    };
};

Trout2.purs

module Trout2 where

import Prelude
import Data.Either (Either(..))
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
import Type.Proxy (Proxy(..))

-- TYPE LEVEL OPERATORS


data Lit (v :: Symbol)

data Resource r

data Sub e t

type LitSub (v :: Symbol) t = Sub (Lit v) t

data Row (l :: Symbol) t

data Alt a b

infixr 5 type Sub as :>
infixr 5 type LitSub as :/
infixl 6 type Row as :=
infixl 4 type Alt as :<|>


-- POLYMORPHIC LABEL HELPERS


foreign import unsafeGet
  :: forall r a
   . String
  -> Record r
  -> a

get
  :: forall r r' l a
   . IsSymbol l
  => RowCons l a r' r
  => SProxy l
  -> Record r
  -> a
get l = unsafeGet (reflectSymbol l)


-- ROUTING


newtype RoutingError = RoutingError { status :: Int }

type RoutingContext = Array String

instance showRoutingError :: Show RoutingError where
  show (RoutingError { status }) = "RoutingError " <> show status

class Router t h out | t -> h, t -> out where
  toRouter :: Proxy t -> RoutingContext -> h -> Either RoutingError out


instance routerResourceRow :: ( RowCons l t handlers handlers'
                              , IsSymbol l
                              )
                              => Router (Resource (l := t)) (Record handlers') t where
  toRouter _ _ h = Right (get (SProxy :: SProxy l) h)

instance routerResourceAlt :: ( RowCons l t handlers handlers'
                              , IsSymbol l
                              , Router (Resource b) (Record handlers') t
                              )
                              => Router (Resource (l := t :<|> b)) (Record handlers') t where
  toRouter _ ctx h =
    -- Just delegate to last router for demo purposes.
    toRouter (Proxy :: Proxy (Resource b)) ctx h

instance routerLitSub :: ( IsSymbol segment
                         , Router sub h out
                         )
                         => Router (Sub (Lit segment) sub) h out where
  toRouter _ ctx r =
    toRouter p ctx' r
    where
      p = Proxy :: Proxy sub
      ctx' = ctx <> [reflectSymbol (SProxy :: SProxy segment)]

instance routerRow :: ( RowCons name handler handlers handlers'
                      , Router route handler out
                      , IsSymbol name
                      )
                      => Router (name := route) (Record handlers') out where
  toRouter _ ctx handlers =
    toRouter p ctx handler
    where
      p = Proxy :: Proxy route
      handler = unsafeGet (reflectSymbol (SProxy :: SProxy name)) handlers

instance routerAltRow :: ( RowCons name handler handlers handlers'
                         , Router route handler out
                         , Router b (Record handlers') out
                         , IsSymbol name
                         )
                         => Router (name := route :<|> b) (Record handlers') out where
  toRouter _ ctx handlers =
    -- Just delegate to last router for demo purposes.
    toRouter (Proxy :: Proxy b) ctx handlers


-- EXAMPLE: Handlers are just strings. The `API` type has two named
-- routes, root and thing.  The thing resource has two verbs, GET and
-- POST, and would be served under the "/things" path. The root
-- resource has only a GET verb, and would be served under the root
-- path.
--
-- As noted in comments above, the routing in itself is not properly
-- implemented. This example only highlights the structure and use of
-- RowCons.

type API =
  "root" := Resource ("GET" := String)
  :<|> "thing" := ("things" :/ Resource ("GET" := String :<|> "POST" := String))


test :: Either RoutingError String
test = toRouter (Proxy :: Proxy API) [] handlers
  where
    handlers = { thing: { "GET": "I am many things."
                        , "POST": "I save things."
                        }
               , root: { "GET": "I am root."
                       }
               }