servant-utils.hs

type Flat api = Reassoc (Flatten api)

-- | Completely flattens an API type by applying a few simple transformations.
--   The goal is to end up with an aPI type where things like @a :> (b :<|> c)@
--   are rewritten to @a :> b :<|> a :> c@, so as to have client with very simple
--   types, instead of "nested clients".
type family Flatten (api :: k) :: k where
  Flatten ((a :: k) :> (b :<|> c)) = a :> Flatten b :<|> Flatten (a :> c)
  Flatten ((a :<|> b) :> c) = a :> Flatten c :<|> (Flatten (b :> c))
  Flatten ((a :: k) :> b)          = Redex b (Flatten b) a
  Flatten (a :<|> b)        = Flatten a :<|> Flatten b
  Flatten (a :: k)          = a

type family Redex a b (c :: k) :: * where
  Redex a a first = Flatten first :> a
  Redex a b first = Flatten (first :> b)

-- | Get the endpoints with given indices in the all-flat
--   representation of the API type, glueing them together
--   with ':<|>'.
type family Nths (idxs :: [Nat]) api where
  Nths  '[i]      api = Nth i api
  Nths  (i ': is) api = Nth i api :<|> Nths is api

-- | Get the endpoint with given index in the all-flat representation
--   of the API type.
type family Nth (i :: Nat) api where
  Nth 0 (a :<|> b) = a
  Nth 0 a          = a
  Nth n (a :<|> b) = Nth (n - 1) b

-- | Reassociates ':<|>'.
type family Reassoc api where
  Reassoc ((a :<|> b) :<|> c) = Reassoc a :<|> Reassoc (b :<|> c)
  Reassoc (a :<|> b) = a :<|> Reassoc b
  Reassoc a = a