servant/servant-examples/tutorial/T10.hs

72 lines
1.9 KiB
Haskell
Raw Normal View History

2015-05-09 16:05:09 +02:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
2015-05-10 13:39:18 +02:00
module T10 where
2015-05-09 16:05:09 +02:00
import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (pack)
import Data.Text.Lazy.Encoding (encodeUtf8)
import Network.HTTP.Types
import Network.Wai
import Servant
import Servant.Docs
2015-05-10 13:39:18 +02:00
import qualified T3
2015-05-09 16:05:09 +02:00
2015-05-10 13:39:18 +02:00
type DocsAPI = T3.API :<|> Raw
2015-05-09 16:05:09 +02:00
instance ToCapture (Capture "x" Int) where
toCapture _ = DocCapture "x" "(integer) position on the x axis"
instance ToCapture (Capture "y" Int) where
toCapture _ = DocCapture "y" "(integer) position on the y axis"
2015-05-10 13:39:18 +02:00
instance ToSample T3.Position T3.Position where
toSample _ = Just (T3.Position 3 14)
2015-05-09 16:05:09 +02:00
instance ToParam (QueryParam "name" String) where
toParam _ =
DocQueryParam "name"
["Alp", "John Doe", "..."]
"Name of the person to say hello to."
Normal
2015-05-10 13:39:18 +02:00
instance ToSample T3.HelloMessage T3.HelloMessage where
2015-05-09 16:05:09 +02:00
toSamples _ =
2015-05-10 13:39:18 +02:00
[ ("When a value is provided for 'name'", T3.HelloMessage "Hello, Alp")
, ("When 'name' is not specified", T3.HelloMessage "Hello, anonymous coward")
2015-05-09 16:05:09 +02:00
]
2015-05-10 13:39:18 +02:00
ci :: T3.ClientInfo
ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
2015-05-09 16:05:09 +02:00
2015-05-10 13:39:18 +02:00
instance ToSample T3.ClientInfo T3.ClientInfo where
2015-05-09 16:05:09 +02:00
toSample _ = Just ci
2015-05-10 13:39:18 +02:00
instance ToSample T3.Email T3.Email where
toSample _ = Just (T3.emailForClient ci)
2015-05-09 16:05:09 +02:00
api :: Proxy DocsAPI
api = Proxy
docsBS :: ByteString
docsBS = encodeUtf8
. pack
. markdown
2015-05-10 13:39:18 +02:00
$ docsWithIntros [intro] T3.api
2015-05-09 16:05:09 +02:00
where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
2015-05-09 16:05:09 +02:00
server :: Server DocsAPI
2015-05-10 13:39:18 +02:00
server = T3.server :<|> serveDocs
2015-05-09 16:05:09 +02:00
where serveDocs _ respond =
respond $ responseLBS ok200 [plain] docsBS
2015-05-09 16:05:09 +02:00
plain = ("Content-Type", "text/plain")
2015-05-09 16:05:09 +02:00
app :: Application
app = serve api server