eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Add ToHttpApiData instance for Link.

Browse source
This commit is contained in:
Julian K. Arni 2015-12-27 02:20:46 +01:00
parent 4a03c6e8b5
commit 8b3258a0c1
1 changed files with 11 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
servant/src/Servant/Utils/Links.hs
View file

@ -103,7 +103,8 @@ module Servant.Utils.Links (
import Data.List import Data.List
import Data.Proxy ( Proxy(..) ) import Data.Proxy ( Proxy(..) )
import Data.Text (Text, unpack) import qualified Data.Text as Text
import qualified Data.ByteString.Char8 as BSC
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Data.Monoid ( Monoid(..), (<>) ) import Data.Monoid ( Monoid(..), (<>) )
#else #else
@ -135,6 +136,10 @@ data Link = Link
, _queryParams :: [Param Query] , _queryParams :: [Param Query]
} deriving Show } deriving Show
instance ToHttpApiData Link where
toUrlPiece = Text.pack . show
toHeader = BSC.pack . show
-- | If either a or b produce an empty constraint, produce an empty constraint. -- | If either a or b produce an empty constraint, produce an empty constraint.
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
-- This works because of: -- This works because of:
@ -193,8 +198,8 @@ data Query
-- | Query param -- | Query param
data Param a data Param a
= SingleParam String Text = SingleParam String Text.Text
| ArrayElemParam String Text | ArrayElemParam String Text.Text
| FlagParam String | FlagParam String
deriving Show deriving Show
@ -218,8 +223,8 @@ linkURI (Link segments q_params) =
"?" <> intercalate "&" (fmap makeQuery xs) "?" <> intercalate "&" (fmap makeQuery xs)
makeQuery :: Param Query -> String makeQuery :: Param Query -> String
makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (unpack v) makeQuery (ArrayElemParam k v) = escape k <> "[]=" <> escape (Text.unpack v)
makeQuery (SingleParam k v) = escape k <> "=" <> escape (unpack v) makeQuery (SingleParam k v) = escape k <> "=" <> escape (Text.unpack v)
makeQuery (FlagParam k) = escape k makeQuery (FlagParam k) = escape k
escape :: String -> String escape :: String -> String
@ -291,7 +296,7 @@ instance (ToHttpApiData v, HasLink sub)
type MkLink (Capture sym v :> sub) = v -> MkLink sub type MkLink (Capture sym v :> sub) = v -> MkLink sub
toLink _ l v = toLink _ l v =
toLink (Proxy :: Proxy sub) $ toLink (Proxy :: Proxy sub) $
addSegment (escape . unpack $ toUrlPiece v) l addSegment (escape . Text.unpack $ toUrlPiece v) l
instance HasLink sub => HasLink (Header sym a :> sub) where instance HasLink sub => HasLink (Header sym a :> sub) where
type MkLink (Header sym a :> sub) = MkLink sub type MkLink (Header sym a :> sub) = MkLink sub