git.iko.soy/servant-reflex
on tuple-api-3 help sign in
servant-reflex/exec/API.hs
72 lines 2.5 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE TypeOperators #-}
5module API where
7import Data.Aeson
8import Data.Aeson.Types (typeMismatch)
9import Data.Text (Text)
10import Servant.API
12newtype Question = Question { unQuestion :: Text } deriving (Show)
14instance ToJSON Question where
15 toJSON (Question txt) = object ["question" .= txt]
17instance FromJSON Question where
18 parseJSON (Object v) = Question <$> v .: "question"
19 parseJSON x = typeMismatch "Couldn't find key 'question'" x
21newtype Answer = Answer { unAnswer :: Text } deriving (Show)
23instance ToJSON Answer where
24 toJSON (Answer txt) = object ["answer" .= txt]
26instance FromJSON Answer where
27 parseJSON (Object v) = Answer <$> v .: "answer"
28 parseJSON x = typeMismatch "Couldn't find key 'answer'" x
31-- | API spec for server, client, and docs
32type API = "getunit" :> Get '[JSON] ()
33 :<|> "getint" :> Get '[JSON] Int
34 :<|> "dblint" :> Capture "anint" Int :> Get '[JSON] Int
35 :<|> "sayhi" :> QueryParam "username" Text
36 :> QueryParams "greetings" Text
37 :> QueryFlag "gusto"
38 :> Get '[JSON] Text
39 :<|> "double" :> ReqBody '[JSON] Double
40 :> Post '[JSON] Double
41 :<|> "a" :> "b" :> QueryFlag "gusto" :> Get '[JSON] Text
42 :<|> "qna" :> ReqBody '[JSON] Question
43 :> Header "qnum" Int
44 :> Header "is-favorite" Bool
45 :> Post '[JSON] (Headers '[Header "anum" Int, Header "was-favorite" Bool] Answer)
46 :<|> "secret" :> BasicAuth "realm" () :> Get '[JSON] Int
47 :<|> Raw
49type GET = Get '[JSON] ()
51-- Imported the comprehensive API example for testing.
52-- https://github.com/haskell-servant/servant/blob/master/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
53type ComprehensiveAPI =
54 GET :<|>
55 Get '[JSON] Int :<|>
56 Capture "foo" Int :> GET :<|>
57 Header "foo" Int :> GET :<|>
58 HttpVersion :> GET :<|>
59 IsSecure :> GET :<|>
60 QueryParam "foo" Int :> GET :<|>
61 QueryParams "foo" Int :> GET :<|>
62 QueryFlag "foo" :> GET :<|>
63-- Raw :<|>
64 RemoteHost :> GET :<|>
65 ReqBody '[JSON] Int :> GET :<|>
66 Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
67 "foo" :> GET :<|>
68 Vault :> GET :<|>
69 Verb 'POST 204 '[JSON] () :<|>
70 Verb 'POST 204 '[JSON] Int
71-- This one isn't in scope
72-- :<|> WithNamedContext "foo" '[] GET