git.iko.soy/typeable/servant-reflex
on json-unrender-text help sign in
typeable/servant-reflex/exec/API.hs
71 lines 2.3 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
21data Answer = Answer {
22 answer :: Text
23 , certainty :: [Text]
24 } deriving (Show)
26instance ToJSON Answer where
27 toJSON (Answer txt crt) = object ["answer" .= txt, "certainty" .= crt]
29instance FromJSON Answer where
30 parseJSON (Object v) = Answer <$> v .: "answer" <*> v .: "certainty"
31 parseJSON x = typeMismatch "Parse error" x
34-- | API spec for server, client, and docs
35type API = "getunit" :> Get '[JSON] ()
36 :<|> "getint" :> Get '[JSON] Int
37 :<|> "sayhi" :> QueryParam "username" Text
38 :> QueryParams "greetings" Text
39 :> QueryFlag "gusto"
40 :> Get '[JSON] Text
41 :<|> "double" :> ReqBody '[JSON] Double
42 :> Post '[JSON] Double
43 :<|> "a" :> "b" :> QueryFlag "gusto" :> Get '[JSON] Text
44 :<|> "qna" :> ReqBody '[JSON] Question
45 :> Post '[JSON] Answer
46 :<|> Raw
48type GET = Get '[JSON] ()
50-- Imported the comprehensive API example for testing.
51-- https://github.com/haskell-servant/servant/blob/master/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
52type ComprehensiveAPI =
53 GET :<|>
54 Get '[JSON] Int :<|>
55 Capture "foo" Int :> GET :<|>
56 Header "foo" Int :> GET :<|>
57 HttpVersion :> GET :<|>
58 IsSecure :> GET :<|>
59 QueryParam "foo" Int :> GET :<|>
60 QueryParams "foo" Int :> GET :<|>
61 QueryFlag "foo" :> GET :<|>
62-- Raw :<|>
63 RemoteHost :> GET :<|>
64 ReqBody '[JSON] Int :> GET :<|>
65 Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
66 "foo" :> GET :<|>
67 Vault :> GET :<|>
68 Verb 'POST 204 '[JSON] () :<|>
69 Verb 'POST 204 '[JSON] Int
70-- This one isn't in scope
71-- :<|> WithNamedContext "foo" '[] GET