git.iko.soy/typeable/servant
on master help sign in
Merge pull request #64 from haskell-servant/getting-started-examples
e3f46edAlp Mestanogullari
servant-examples/servant-examples.cabal+39
compare with master
unifiedsplit
@@ -13,6 +13,45 @@ category: Web
13build-type: Simple
13build-type: Simple
14cabal-version: >=1.10
14cabal-version: >=1.10
15
15
16+executable tutorial
17+ main-is: tutorial.hs
18+ other-modules: T1, T2, T3, T4, T5, T6, T7, T8, T9, T10
19+ build-depends:
20+ aeson >= 0.8
21+ , base >= 4.7
22+ , bytestring
23+ , directory
24+ , either
25+ , http-types
26+ , js-jquery
27+ , lucid
28+ , random
29+ , servant
30+ , servant-docs
31+ , servant-jquery
32+ , servant-lucid
33+ , servant-server
34+ , text
35+ , time
36+ , transformers
37+ , wai
38+ , warp
39+ hs-source-dirs: tutorial
40+ default-language: Haskell2010
41+
42+executable t8-main
43+ main-is: t8-main.hs
44+ hs-source-dirs: tutorial
45+ default-language: Haskell2010
46+ build-depends:
47+ aeson
48+ , base
49+ , either
50+ , servant
51+ , servant-client
52+ , servant-server
53+ , wai
54+
16executable hackage
55executable hackage
17 main-is: hackage.hs
56 main-is: hackage.hs
18 build-depends:
57 build-depends:
servant-examples/tutorial/T1.hsnew file+42
@@ -0,0 +1,42 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module T1 where
6+
7+import Data.Aeson
8+import Data.Time.Calendar
9+import GHC.Generics
10+import Network.Wai
11+import Servant
12+
13+data User = User
14+ { name :: String
15+ , age :: Int
16+ , email :: String
17+ , registration_date :: Day
18+ } deriving (Eq, Show, Generic)
19+
20+-- orphan ToJSON instance for Day. necessary to derive one for User
21+instance ToJSON Day where
22+ -- display a day in YYYY-mm-dd format
23+ toJSON d = toJSON (showGregorian d)
24+
25+instance ToJSON User
26+
27+type UserAPI = "users" :> Get '[JSON] [User]
28+
29+users :: [User]
30+users =
31+ [ User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
32+ , User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
33+ ]
34+
35+userAPI :: Proxy UserAPI
36+userAPI = Proxy
37+
38+server :: Server UserAPI
39+server = return users
40+
41+app :: Application
42+app = serve userAPI server
servant-examples/tutorial/T10.hsnew file+71
@@ -0,0 +1,71 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeOperators #-}
4+{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+{-# LANGUAGE MultiParamTypeClasses #-}
7+module T10 where
8+
9+import Data.ByteString.Lazy (ByteString)
10+import Data.Text.Lazy (pack)
11+import Data.Text.Lazy.Encoding (encodeUtf8)
12+import Network.HTTP.Types
13+import Network.Wai
14+import Servant
15+import Servant.Docs
16+import qualified T3
17+
18+type DocsAPI = T3.API :<|> Raw
19+
20+instance ToCapture (Capture "x" Int) where
21+ toCapture _ = DocCapture "x" "(integer) position on the x axis"
22+
23+instance ToCapture (Capture "y" Int) where
24+ toCapture _ = DocCapture "y" "(integer) position on the y axis"
25+
26+instance ToSample T3.Position T3.Position where
27+ toSample _ = Just (T3.Position 3 14)
28+
29+instance ToParam (QueryParam "name" String) where
30+ toParam _ =
31+ DocQueryParam "name"
32+ ["Alp", "John Doe", "..."]
33+ "Name of the person to say hello to."
34+ Normal
35+
36+instance ToSample T3.HelloMessage T3.HelloMessage where
37+ toSamples _ =
38+ [ ("When a value is provided for 'name'", T3.HelloMessage "Hello, Alp")
39+ , ("When 'name' is not specified", T3.HelloMessage "Hello, anonymous coward")
40+ ]
41+
42+ci :: T3.ClientInfo
43+ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
44+
45+instance ToSample T3.ClientInfo T3.ClientInfo where
46+ toSample _ = Just ci
47+
48+instance ToSample T3.Email T3.Email where
49+ toSample _ = Just (T3.emailForClient ci)
50+
51+api :: Proxy DocsAPI
52+api = Proxy
53+
54+docsBS :: ByteString
55+docsBS = encodeUtf8
56+ . pack
57+ . markdown
58+ $ docsWithIntros [intro] T3.api
59+
60+ where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
61+
62+server :: Server DocsAPI
63+server = T3.server :<|> serveDocs
64+
65+ where serveDocs _ respond =
66+ respond $ responseLBS ok200 [plain] docsBS
67+
68+ plain = ("Content-Type", "text/plain")
69+
70+app :: Application
71+app = serve api server
servant-examples/tutorial/T2.hsnew file+49
@@ -0,0 +1,49 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module T2 where
6+
7+import Data.Aeson
8+import Data.Time.Calendar
9+import GHC.Generics
10+import Network.Wai
11+import Servant
12+
13+data User = User
14+ { name :: String
15+ , age :: Int
16+ , email :: String
17+ , registration_date :: Day
18+ } deriving (Eq, Show, Generic)
19+
20+-- orphan ToJSON instance for Day. necessary to derive one for User
21+instance ToJSON Day where
22+ -- display a day in YYYY-mm-dd format
23+ toJSON d = toJSON (showGregorian d)
24+
25+instance ToJSON User
26+
27+type UserAPI = "users" :> Get '[JSON] [User]
28+ :<|> "albert" :> Get '[JSON] User
29+ :<|> "isaac" :> Get '[JSON] User
30+
31+isaac :: User
32+isaac = User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
33+
34+albert :: User
35+albert = User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
36+
37+users :: [User]
38+users = [isaac, albert]
39+
40+userAPI :: Proxy UserAPI
41+userAPI = Proxy
42+
43+server :: Server UserAPI
44+server = return users
45+ :<|> return albert
46+ :<|> return isaac
47+
48+app :: Application
49+app = serve userAPI server
servant-examples/tutorial/T3.hsnew file+84
@@ -0,0 +1,84 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module T3 where
6+
7+import Control.Monad.Trans.Either
8+import Data.Aeson
9+import Data.List
10+import GHC.Generics
11+import Network.Wai
12+import Servant
13+
14+data Position = Position
15+ { x :: Int
16+ , y :: Int
17+ } deriving (Show, Generic)
18+
19+instance FromJSON Position
20+instance ToJSON Position
21+
22+newtype HelloMessage = HelloMessage { msg :: String }
23+ deriving (Show, Generic)
24+
25+instance FromJSON HelloMessage
26+instance ToJSON HelloMessage
27+
28+data ClientInfo = ClientInfo
29+ { name :: String
30+ , email :: String
31+ , age :: Int
32+ , interested_in :: [String]
33+ } deriving (Show, Generic)
34+
35+instance FromJSON ClientInfo
36+instance ToJSON ClientInfo
37+
38+data Email = Email
39+ { from :: String
40+ , to :: String
41+ , subject :: String
42+ , body :: String
43+ } deriving (Show, Generic)
44+
45+instance FromJSON Email
46+instance ToJSON Email
47+
48+emailForClient :: ClientInfo -> Email
49+emailForClient c = Email from' to' subject' body'
50+
51+ where from' = "great@company.com"
52+ to' = email c
53+ subject' = "Hey " ++ name c ++ ", we miss you!"
54+ body' = "Hi " ++ name c ++ ",\n\n"
55+ ++ "Since you've recently turned " ++ show (age c)
56+ ++ ", have you checked out our latest "
57+ ++ intercalate ", " (interested_in c)
58+ ++ " products? Give us a visit!"
59+
60+type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
61+ :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
62+ :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
63+
64+api :: Proxy API
65+api = Proxy
66+
67+server :: Server API
68+server = position
69+ :<|> hello
70+ :<|> marketing
71+
72+ where position :: Int -> Int -> EitherT ServantErr IO Position
73+ position x y = return (Position x y)
74+
75+ hello :: Maybe String -> EitherT ServantErr IO HelloMessage
76+ hello mname = return . HelloMessage $ case mname of
77+ Nothing -> "Hello, anonymous coward"
78+ Just n -> "Hello, " ++ n
79+
80+ marketing :: ClientInfo -> EitherT ServantErr IO Email
81+ marketing clientinfo = return (emailForClient clientinfo)
82+
83+app :: Application
84+app = serve api server
servant-examples/tutorial/T4.hsnew file+63
@@ -0,0 +1,63 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE OverloadedStrings #-}
7+module T4 where
8+
9+import Data.Aeson
10+import Data.Foldable (foldMap)
11+import GHC.Generics
12+import Lucid
13+import Network.Wai
14+import Servant
15+import Servant.HTML.Lucid
16+
17+data Person = Person
18+ { firstName :: String
19+ , lastName :: String
20+ , age :: Int
21+ } deriving Generic -- for the JSON instance
22+
23+-- JSON serialization
24+instance ToJSON Person
25+
26+-- HTML serialization of a single person
27+instance ToHtml Person where
28+ toHtml p =
29+ tr_ $ do
30+ td_ (toHtml $ firstName p)
31+ td_ (toHtml $ lastName p)
32+ td_ (toHtml . show $ age p)
33+
34+ toHtmlRaw = toHtml
35+
36+-- HTML serialization of a list of persons
37+instance ToHtml [Person] where
38+ toHtml persons = table_ $ do
39+ tr_ $ do
40+ td_ "first name"
41+ td_ "last name"
42+ td_ "age"
43+
44+ foldMap toHtml persons
45+
46+ toHtmlRaw = toHtml
47+
48+persons :: [Person]
49+persons =
50+ [ Person "Isaac" "Newton" 372
51+ , Person "Albert" "Einstein" 136
52+ ]
53+
54+type PersonAPI = "persons" :> Get '[JSON, HTML] [Person]
55+
56+personAPI :: Proxy PersonAPI
57+personAPI = Proxy
58+
59+server :: Server PersonAPI
60+server = return persons
61+
62+app :: Application
63+app = serve personAPI server
servant-examples/tutorial/T5.hsnew file+37
@@ -0,0 +1,37 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+module T5 where
7+
8+import Control.Monad.IO.Class
9+import Control.Monad.Trans.Either
10+import Data.Aeson
11+import GHC.Generics
12+import Network.Wai
13+import Servant
14+import System.Directory
15+
16+type IOAPI = "myfile.txt" :> Get '[JSON] FileContent
17+
18+ioAPI :: Proxy IOAPI
19+ioAPI = Proxy
20+
21+newtype FileContent = FileContent
22+ { content :: String }
23+ deriving Generic
24+
25+instance ToJSON FileContent
26+
27+server :: Server IOAPI
28+server = do
29+ exists <- liftIO (doesFileExist "myfile.txt")
30+ if exists
31+ then liftIO (readFile "myfile.txt") >>= return . FileContent
32+ else left custom404Err
33+
34+ where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." }
35+
36+app :: Application
37+app = serve ioAPI server
servant-examples/tutorial/T6.hsnew file+18
@@ -0,0 +1,18 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeOperators #-}
4+module T6 where
5+
6+import Network.Wai
7+import Servant
8+
9+type API = "code" :> Raw
10+
11+api :: Proxy API
12+api = Proxy
13+
14+server :: Server API
15+server = serveDirectory "tutorial"
16+
17+app :: Application
18+app = serve api server
servant-examples/tutorial/T7.hsnew file+33
@@ -0,0 +1,33 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeOperators #-}
4+module T7 where
5+
6+import Control.Monad.Trans.Either
7+import Control.Monad.Trans.Reader
8+import Network.Wai
9+import Servant
10+
11+type ReaderAPI = "a" :> Get '[JSON] Int
12+ :<|> "b" :> Get '[JSON] String
13+
14+readerAPI :: Proxy ReaderAPI
15+readerAPI = Proxy
16+
17+readerServerT :: ServerT ReaderAPI (Reader String)
18+readerServerT = a :<|> b
19+
20+ where a :: Reader String Int
21+ a = return 1797
22+
23+ b :: Reader String String
24+ b = ask
25+
26+readerServer :: Server ReaderAPI
27+readerServer = enter readerToEither readerServerT
28+
29+ where readerToEither :: Reader String :~> EitherT ServantErr IO
30+ readerToEither = Nat $ \r -> return (runReader r "hi")
31+
32+app :: Application
33+app = serve readerAPI readerServer
servant-examples/tutorial/T8.hsnew file+43
@@ -0,0 +1,43 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE TypeOperators #-}
4+module T8 where
5+
6+import Control.Monad.Trans.Either
7+import Data.Aeson
8+import Servant
9+import Servant.Client
10+
11+import T3
12+
13+position :: Int -- ^ value for "x"
14+ -> Int -- ^ value for "y"
15+ -> EitherT ServantError IO Position
16+
17+hello :: Maybe String -- ^ an optional value for "name"
18+ -> EitherT ServantError IO HelloMessage
19+
20+marketing :: ClientInfo -- ^ value for the request body
21+ -> EitherT ServantError IO Email
22+
23+position :<|> hello :<|> marketing = client api baseUrl
24+
25+baseUrl :: BaseUrl
26+baseUrl = BaseUrl Http "localhost" 8081
27+
28+queries :: EitherT ServantError IO (Position, HelloMessage, Email)
29+queries = do
30+ pos <- position 10 10
31+ msg <- hello (Just "servant")
32+ em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])
33+ return (pos, msg, em)
34+
35+run :: IO ()
36+run = do
37+ res <- runEitherT queries
38+ case res of
39+ Left err -> putStrLn $ "Error: " ++ show err
40+ Right (pos, msg, em) -> do
41+ print pos
42+ print msg
43+ print em
servant-examples/tutorial/T9.hsnew file+104
@@ -0,0 +1,104 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+{-# LANGUAGE OverloadedStrings #-}
6+module T9 where
7+
8+import Control.Applicative
9+import Control.Monad.IO.Class
10+import Data.Aeson
11+import Data.Text (Text)
12+import GHC.Generics
13+import Network.Wai
14+import Servant
15+import Servant.JQuery
16+import System.Random
17+
18+import qualified Data.Text as T
19+import qualified Language.Javascript.JQuery as JQ
20+
21+data Point = Point
22+ { x :: Double
23+ , y :: Double
24+ } deriving Generic
25+
26+instance ToJSON Point
27+
28+randomPoint :: MonadIO m => m Point
29+randomPoint = liftIO . getStdRandom $ \g ->
30+ let (rx, g') = randomR (-1, 1) g
31+ (ry, g'') = randomR (-1, 1) g'
32+ in (Point rx ry, g'')
33+
34+data Search a = Search
35+ { query :: Text
36+ , results :: [a]
37+ } deriving Generic
38+
39+mkSearch :: Text -> [a] -> Search a
40+mkSearch = Search
41+
42+instance ToJSON a => ToJSON (Search a)
43+
44+data Book = Book
45+ { author :: Text
46+ , title :: Text
47+ , year :: Int
48+ } deriving Generic
49+
50+instance ToJSON Book
51+
52+book :: Text -> Text -> Int -> Book
53+book = Book
54+
55+books :: [Book]
56+books =
57+ [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
58+ , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
59+ , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
60+ , book "Graham Hutton" "Programming in Haskell" 2007
61+ , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
62+ , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
63+ ]
64+
65+searchBook :: Monad m => Maybe Text -> m (Search Book)
66+searchBook Nothing = return (mkSearch "" books)
67+searchBook (Just q) = return (mkSearch q books')
68+
69+ where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
70+ || q' `T.isInfixOf` T.toLower (title b)
71+ )
72+ books
73+ q' = T.toLower q
74+
75+type API = "point" :> Get '[JSON] Point
76+ :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
77+
78+type API' = API :<|> Raw
79+
80+api :: Proxy API
81+api = Proxy
82+
83+api' :: Proxy API'
84+api' = Proxy
85+
86+server :: Server API
87+server = randomPoint
88+ :<|> searchBook
89+
90+server' :: Server API'
91+server' = server
92+ :<|> serveDirectory "tutorial/t9"
93+
94+apiJS :: String
95+apiJS = jsForAPI api
96+
97+writeJSFiles :: IO ()
98+writeJSFiles = do
99+ writeFile "tutorial/t9/api.js" apiJS
100+ jq <- readFile =<< JQ.file
101+ writeFile "tutorial/t9/jq.js" jq
102+
103+app :: Application
104+app = serve api' server'
servant-examples/tutorial/t8-main.hsnew file+4
@@ -0,0 +1,4 @@
1+import T8
2+
3+main :: IO ()
4+main = run
servant-examples/tutorial/t9/index.htmlnew file+26
@@ -0,0 +1,26 @@
1+<!DOCTYPE html>
2+<html lang="en">
3+ <head>
4+ <meta name="viewport" content="width=device-width, initial-scale=1">
5+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
6+ <title>Tutorial - 9 - servant-jquery</title>
7+ </head>
8+ <body>
9+ <h1>Books</h1>
10+ <input type="search" name="q" id="q" placeholder="Search author or book title..." />
11+ <div>
12+ <p>Results for <strong id="query">""</strong></p>
13+ <ul id="results">
14+ </ul>
15+ </div>
16+ <hr />
17+ <h1>Approximating &pi;</h1>
18+ <p>Count: <span id="count">0</span></p>
19+ <p>Successes: <span id="successes">0</span></p>
20+ <p id="pi"></p>
21+
22+ <script type="text/javascript" src="/jq.js"></script>
23+ <script type="text/javascript" src="/api.js"></script>
24+ <script type="text/javascript" src="/ui.js"></script>
25+
26+ </body>
servant-examples/tutorial/t9/ui.jsnew file+61
@@ -0,0 +1,61 @@
1+/* book search */
2+function updateResults(data)
3+{
4+ console.log(data);
5+ $('#results').html("");
6+ $('#query').text("\"" + data.query + "\"");
7+ for(var i = 0; i < data.results.length; i++)
8+ {
9+ $('#results').append(renderBook(data.results[i]));
10+ }
11+}
12+
13+function renderBook(book)
14+{
15+ var li = '<li><strong>' + book.title + '</strong>, <i>'
16+ + book.author + '</i> - ' + book.year + '</li>';
17+ return li;
18+}
19+
20+function searchBooks()
21+{
22+ var q = $('#q').val();
23+ getbooks(q, updateResults, console.log)
24+}
25+
26+searchBooks();
27+$('#q').keyup(function() {
28+ searchBooks();
29+});
30+
31+/* approximating pi */
32+var count = 0;
33+var successes = 0;
34+
35+function f(data)
36+{
37+ var x = data.x, y = data.y;
38+ if(x*x + y*y <= 1)
39+ {
40+ successes++;
41+ }
42+
43+ count++;
44+
45+ update('#count', count);
46+ update('#successes', successes);
47+ update('#pi', 4*successes/count);
48+}
49+
50+function update(id, val)
51+{
52+ $(id).text(val);
53+}
54+
55+function refresh()
56+{
57+ getpoint(f, console.log);
58+}
59+
60+window.setInterval(refresh, 200);
61+
servant-examples/tutorial/tutorial.hsnew file+39
@@ -0,0 +1,39 @@
1+import Network.Wai
2+import Network.Wai.Handler.Warp
3+import System.Environment
4+
5+import qualified T1
6+import qualified T2
7+import qualified T3
8+import qualified T4
9+import qualified T5
10+import qualified T6
11+import qualified T7
12+import qualified T9
13+import qualified T10
14+
15+app :: String -> (Application -> IO ()) -> IO ()
16+app n f = case n of
17+ "1" -> f T1.app
18+ "2" -> f T2.app
19+ "3" -> f T3.app
20+ "4" -> f T4.app
21+ "5" -> f T5.app
22+ "6" -> f T6.app
23+ "7" -> f T7.app
24+ "8" -> f T3.app
25+ "9" -> T9.writeJSFiles >> f T9.app
26+ "10" -> f T10.app
27+ _ -> usage
28+
29+main :: IO ()
30+main = do
31+ args <- getArgs
32+ case args of
33+ [n] -> app n (run 8081)
34+ _ -> usage
35+
36+usage :: IO ()
37+usage = do
38+ putStrLn "Usage:\t tutorial N"
39+ putStrLn "\t\twhere N is the number of the example you want to run."