git.iko.soy/servant
on 82ff0a6 help sign in
servant/src/Servant/API/Capture.hs
66 lines 2.0 kB history raw
1{-# LANGUAGE PolyKinds #-}
2{-# LANGUAGE TypeFamilies #-}
3{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7module Servant.API.Capture where
9import Data.Proxy
10import Data.Text
11import GHC.TypeLits
12import Network.Wai
13import Servant.API.Sub
14import Servant.Client
15import Servant.Common.Req
16import Servant.Common.Text
17import Servant.Docs
18import Servant.Server
20-- * Captures
21data Capture sym a
23captured :: FromText a => proxy (Capture sym a) -> Text -> Maybe a
24captured _ = fromText
26instance (KnownSymbol capture, FromText a, HasServer sublayout)
27 => HasServer (Capture capture a :> sublayout) where
29 type Server (Capture capture a :> sublayout) =
30 a -> Server sublayout
32 route Proxy subserver request respond = case pathInfo request of
33 (first : rest)
34 -> case captured captureProxy first of
35 Nothing -> respond $ failWith NotFound
36 Just v -> route (Proxy :: Proxy sublayout) (subserver v) request{
37 pathInfo = rest
38 } respond
39 _ -> respond $ failWith NotFound
41 where captureProxy = Proxy :: Proxy (Capture capture a)
43instance (KnownSymbol capture, ToText a, HasClient sublayout)
44 => HasClient (Capture capture a :> sublayout) where
46 type Client (Capture capture a :> sublayout) =
47 a -> Client sublayout
49 clientWithRoute Proxy req val =
50 clientWithRoute (Proxy :: Proxy sublayout) $
51 appendToPath p req
53 where p = unpack (toText val)
55instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
56 => HasDocs (Capture sym a :> sublayout) where
58 docsFor Proxy (endpoint, action) =
59 docsFor sublayoutP (endpoint', action')
61 where sublayoutP = Proxy :: Proxy sublayout
62 captureP = Proxy :: Proxy (Capture sym a)
64 action' = over captures (|> toCapture captureP) action
65 endpoint' = over path (\p -> p++"/:"++symbolVal symP) endpoint
66 symP = Proxy :: Proxy sym