use a newtype instance a type synonym instance

src/Application.hs

@@ -1,9 +1,7 @@
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE KindSignatures       #-}
 {-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE DeriveGeneric        #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
 {-|
 This module contains the web application
@@ -51,8 +49,13 @@ data ApiReply = ApiReply
 
 instance ToJSON ApiReply
 
-instance FromForm Url where
-  fromForm f = parseUnique "url" f
+-- | This type is just a wrapped around a 'Text'
+-- value. It's used to create a 'FromForm' instance
+-- for a 'Url'.
+newtype UrlForm = UrlForm Text
+
+instance FromForm UrlForm where
+  fromForm f = UrlForm <$> parseUnique "url" f
 
 
 -- * Breve API
@@ -82,7 +85,7 @@ type App =
        Get '[HTML] Html
   :<|> "static" :> Raw
   :<|> Capture "name" Name :> Redirect
-  :<|> ReqBody '[FormUrlEncoded] Url :> Post '[HTML] Html
+  :<|> ReqBody '[FormUrlEncoded] UrlForm :> Post '[HTML] Html
 
 -- | JSON API spec
 --
@@ -92,7 +95,7 @@ type App =
 -- | /        | POST | upload a new url     |
 -- +----------+------+----------------------+
 type API =
-  "api" :> ReqBody '[FormUrlEncoded] Url :> Post '[JSON] ApiReply
+  "api" :> ReqBody '[FormUrlEncoded] UrlForm :> Post '[JSON] ApiReply
 
 -- | Breve application
 --
@@ -138,18 +141,18 @@ resolver table name = do
       pure (addHeader url NoContent)
 
 
--- | Takes a 'Url' via POST
+-- | Takes a 'UrlForm' via POST
 -- and prints the shortned one
-uploader :: Url -> UrlTable -> Url -> Handler Html
-uploader bindUrl table url = do
+uploader :: Url -> UrlTable -> UrlForm -> Handler Html
+uploader bindUrl table (UrlForm url) = do
   name <- liftIO (insert table url)
   logStr ("Registered " <> url <> " -> " <> name)
   pure (done $ bindUrl <> name)
 
 -- | Takes a 'Url' via POST and returns
 -- the shortned one in an 'ApiReply' as JSON.
-api :: Url -> UrlTable -> Url -> Handler ApiReply
-api bindUrl table url = do
+api :: Url -> UrlTable -> UrlForm -> Handler ApiReply
+api bindUrl table (UrlForm url) = do
   name <- liftIO (insert table url)
   logStr ("Registered " <> url <> " -> " <> name)
   pure $ ApiReply { link     = (bindUrl <> name)