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

examples: add GS10

Browse source
This commit is contained in:
Alp Mestanogullari 2015-05-09 16:05:09 +02:00
parent 77b15e9cdc
commit 616b203792
4 changed files with 118 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

94
servant-examples/getting-started/GS10.hs Normal file
View file

@ -0,0 +1,94 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module GS10 where
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
import Servant.Docs.Pandoc (pandoc)
import Text.Pandoc.Options (def, WriterOptions(..))
import Text.Pandoc.Writers.HTML (writeHtmlString)
import qualified GS3
type DocsAPI = GS3.API :<|> Raw
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"
instance ToSample GS3.Position GS3.Position where
toSample _ = Just (GS3.Position 3 14)
instance ToParam (QueryParam "name" String) where
toParam _ =
DocQueryParam "name"
["Alp", "John Doe", "..."]
"Name of the person to say hello to."
Normal
instance ToSample GS3.HelloMessage GS3.HelloMessage where
toSamples _ =
[ ("When a value is provided for 'name'", GS3.HelloMessage "Hello, Alp")
, ("When 'name' is not specified", GS3.HelloMessage "Hello, anonymous coward")
]
ci :: GS3.ClientInfo
ci = GS3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
instance ToSample GS3.ClientInfo GS3.ClientInfo where
toSample _ = Just ci
instance ToSample GS3.Email GS3.Email where
toSample _ = Just (GS3.emailForClient ci)
api :: Proxy DocsAPI
api = Proxy
docsBS :: ByteString
docsBS = encodeUtf8
. pack
. writeHtmlString opts
. pandoc
$ docsWithIntros [intro] GS3.api
where opts = def { writerHtml5 = True
, writerTableOfContents = True
, writerHighlight = True
, writerStandalone = True
, writerTemplate =
concat
[ "<!DOCTYPE html><html>"
, "<head>"
, "<meta charset=\"UTF-8\">"
, "<title>API Docs - $title$</title>"
, "</head>"
, "<body>"
, "$toc$"
, "<hr />"
, "$body$"
, "</body>"
, "</html>"
]
}
intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
server :: Server DocsAPI
server = GS3.server :<|> serveDocs
where serveDocs _ respond =
respond $ responseLBS ok200 [html] docsBS
html = ("Content-Type", "text/html")
app :: Application
app = serve api server

28
servant-examples/getting-started/GS9.hs
View file

@ -2,20 +2,22 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module GS9 where
import Control.Applicative
import Control.Monad.IO.Class
import Data.Aeson
import Data.Char
import Data.List
import Data.Text (Text)
import GHC.Generics
import qualified Language.Javascript.JQuery as JQ
import Math.Probable
import Network.Wai
import Servant
import Servant.JQuery
import qualified Data.Text as T
import qualified Language.Javascript.JQuery as JQ
data Point = Point
{ x :: Double
, y :: Double
@ -29,24 +31,24 @@ randomPoint = liftIO . mwc $ Point <$> d <*> d
where d = doubleIn (-1, 1)
data Search a = Search
{ query :: String
{ query :: Text
, results :: [a]
} deriving Generic
mkSearch :: String -> [a] -> Search a
mkSearch :: Text -> [a] -> Search a
mkSearch = Search
instance ToJSON a => ToJSON (Search a)
data Book = Book
{ author :: String
, title :: String
{ author :: Text
, title :: Text
, year :: Int
} deriving Generic
instance ToJSON Book
book :: String -> String -> Int -> Book
book :: Text -> Text -> Int -> Book
book = Book
books :: [Book]
@ -59,18 +61,18 @@ books =
, book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
]
searchBook :: Monad m => Maybe String -> m (Search Book)
searchBook :: Monad m => Maybe Text -> m (Search Book)
searchBook Nothing = return (mkSearch "" books)
searchBook (Just q) = return (mkSearch q books')
where books' = filter (\b -> q' `isInfixOf` map toLower (author b)
|| q' `isInfixOf` map toLower (title b)
where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
|| q' `T.isInfixOf` T.toLower (title b)
)
books
q' = map toLower q
q' = T.toLower q
type API = "point" :> Get '[JSON] Point
:<|> "books" :> QueryParam "q" String :> Get '[JSON] (Search Book)
:<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
type API' = API :<|> Raw

2
servant-examples/getting-started/getting-started.hs
View file

@ -10,6 +10,7 @@ import qualified GS5
import qualified GS6
import qualified GS7
import qualified GS9
import qualified GS10
app :: String -> (Application -> IO ()) -> IO ()
app n f = case n of
@ -22,6 +23,7 @@ app n f = case n of
"7" -> f GS7.app
"8" -> f GS3.app
"9" -> GS9.writeJSFiles >> f GS9.app
"10" -> f GS10.app
_ -> usage
main :: IO ()

8
servant-examples/servant-examples.cabal
View file

@ -15,19 +15,25 @@ cabal-version: >=1.10
executable getting-started
main-is: getting-started.hs
other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9
other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9, GS10
build-depends:
aeson >= 0.8
, base >= 4.7
, bytestring
, directory
, either
, http-types
, js-jquery
, lucid
, pandoc
, probable
, servant
, servant-docs
, servant-jquery
, servant-lucid
, servant-pandoc >= 0.2
, servant-server
, text
, time
, transformers
, wai