Skip to content

Instantly share code, notes, and snippets.

@alpmestan
Created November 18, 2017 16:35
Show Gist options
  • Save alpmestan/38e00f83051091e84dddd48600a58db5 to your computer and use it in GitHub Desktop.
Save alpmestan/38e00f83051091e84dddd48600a58db5 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment