Merge pull request #23 from haskell-servant/canonical-types

Add the `Canonicalize` type family to reduce API types to their canonical forms before proceeding in the other packages

CHANGELOG.md

@@ -1,5 +1,6 @@
 0.3
 ---
+* Add a `Canonicalize` type family that distributes all `:>`s inside `:<|>`s to get to the canonical type of an API -- which is then used in all other packages to avoid weird handler types in *servant-server*.
 * Multiple content-type/accept support for all the relevant combinators
 * Provide *JSON*, *PlainText*, *OctetStream* and *FormUrlEncoded* content types out of the box
 * Type-safe link generation to API endpoints

src/Servant/API.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Servant.API (
 
   -- * Combinators
@@ -43,11 +46,16 @@ module Servant.API (
   module Servant.Common.Text,
   -- | Classes and instances for types that can be converted to and from @Text@
 
+  -- * Canonicalizing (flattening) API types
+  Canonicalize,
+  canonicalize,
+
   -- * Utilities
   module Servant.Utils.Links,
   -- | Type-safe internal URIs
   ) where
 
+import           Data.Proxy               (Proxy(..))
 import           Servant.Common.Text      (FromText(..), ToText(..))
 import           Servant.API.Alternative  ((:<|>) (..))
 import           Servant.API.Capture      (Capture)
@@ -69,3 +77,34 @@ import           Servant.API.ReqBody      (ReqBody)
 import           Servant.API.Sub          ((:>))
 import           Servant.Utils.Links      (HasLink (..), IsElem, IsElem',
                                            URI (..), safeLink)
+
+-- | Turn an API type into its canonical form.
+--
+-- The canonical form of an API type is basically the all-flattened form
+-- of the original type. More formally, it takes a type as input and hands you
+-- back an /equivalent/ type formed of toplevel `:<|>`-separated chains of `:>`s,
+-- i.e with all `:>`s distributed inside the `:<|>`s.
+--
+-- It basically turns:
+--
+-- > "hello" :> (Get Hello :<|> ReqBody Hello :> Put Hello)
+--
+-- into
+--
+-- > ("hello" :> Get Hello) :<|> ("hello" :> ReqBody Hello :> Put Hello)
+--
+-- i.e distributing all ':>'-separated bits into the subsequent ':<|>'s.
+type family Canonicalize api :: * where
+  -- requires UndecidableInstances
+  Canonicalize (a :> (b :<|> c)) = a :> Canonicalize b :<|> a :> Canonicalize c
+  Canonicalize ((a :<|> b) :> c) = a :> Canonicalize c :<|> b :> Canonicalize c
+  Canonicalize (a :> b)          = Redex b (Canonicalize b) a
+  Canonicalize (a :<|> b)        = Canonicalize a :<|> Canonicalize b
+  Canonicalize a                 = a
+
+type family Redex a b c :: * where
+  Redex a a first = Canonicalize first :> a
+  Redex a b first = Canonicalize (first :> b)
+
+canonicalize :: Proxy layout -> Proxy (Canonicalize layout)
+canonicalize Proxy = Proxy

src/Servant/API/ContentTypes.hs

@@ -55,6 +55,8 @@ module Servant.API.ContentTypes
     , AcceptHeader(..)
     , AllCTRender(..)
     , AllCTUnrender(..)
+    , AllMimeRender(..)
+    , AllMimeUnrender(..)
     , FromFormUrlEncoded(..)
     , ToFormUrlEncoded(..)
     , IsNonEmpty