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 TypeFamilies #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
module GS9 where module GS9 where
import Control.Applicative import Control.Applicative
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import Data.Char import Data.Text (Text)
import Data.List
import GHC.Generics import GHC.Generics
import qualified Language.Javascript.JQuery as JQ
import Math.Probable import Math.Probable
import Network.Wai import Network.Wai
import Servant import Servant
import Servant.JQuery import Servant.JQuery
import qualified Data.Text as T
import qualified Language.Javascript.JQuery as JQ
data Point = Point data Point = Point
{ x :: Double { x :: Double
, y :: Double , y :: Double
@ -29,24 +31,24 @@ randomPoint = liftIO . mwc $ Point <$> d <*> d
where d = doubleIn (-1, 1) where d = doubleIn (-1, 1)
data Search a = Search data Search a = Search
{ query :: String { query :: Text
, results :: [a] , results :: [a]
} deriving Generic } deriving Generic
mkSearch :: String -> [a] -> Search a mkSearch :: Text -> [a] -> Search a
mkSearch = Search mkSearch = Search
instance ToJSON a => ToJSON (Search a) instance ToJSON a => ToJSON (Search a)
data Book = Book data Book = Book
{ author :: String { author :: Text
, title :: String , title :: Text
, year :: Int , year :: Int
} deriving Generic } deriving Generic
instance ToJSON Book instance ToJSON Book
book :: String -> String -> Int -> Book book :: Text -> Text -> Int -> Book
book = Book book = Book
books :: [Book] books :: [Book]
@ -59,18 +61,18 @@ books =
, book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998 , 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 Nothing = return (mkSearch "" books)
searchBook (Just q) = return (mkSearch q books') searchBook (Just q) = return (mkSearch q books')
where books' = filter (\b -> q' `isInfixOf` map toLower (author b) where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
|| q' `isInfixOf` map toLower (title b) || q' `T.isInfixOf` T.toLower (title b)
) )
books books
q' = map toLower q q' = T.toLower q
type API = "point" :> Get '[JSON] Point 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 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 GS6
import qualified GS7 import qualified GS7
import qualified GS9 import qualified GS9
import qualified GS10
app :: String -> (Application -> IO ()) -> IO () app :: String -> (Application -> IO ()) -> IO ()
app n f = case n of app n f = case n of
@ -22,6 +23,7 @@ app n f = case n of
"7" -> f GS7.app "7" -> f GS7.app
"8" -> f GS3.app "8" -> f GS3.app
"9" -> GS9.writeJSFiles >> f GS9.app "9" -> GS9.writeJSFiles >> f GS9.app
"10" -> f GS10.app
_ -> usage _ -> usage
main :: IO () main :: IO ()

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

@ -15,19 +15,25 @@ cabal-version: >=1.10
executable getting-started executable getting-started
main-is: getting-started.hs 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: build-depends:
aeson >= 0.8 aeson >= 0.8
, base >= 4.7 , base >= 4.7
, bytestring
, directory , directory
, either , either
, http-types
, js-jquery , js-jquery
, lucid , lucid
, pandoc
, probable , probable
, servant , servant
, servant-docs
, servant-jquery , servant-jquery
, servant-lucid , servant-lucid
, servant-pandoc >= 0.2
, servant-server , servant-server
, text
, time , time
, transformers , transformers
, wai , wai