git.iko.soy/servant
on master help sign in
examples: add GS9
77b15e9Alp Mestanogullari
servant-examples/getting-started/GS9.hsnew file+101
compare with master
unifiedsplit
@@ -0,0 +1,101 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE DeriveGeneric #-}
4+{-# LANGUAGE TypeOperators #-}
5+module GS9 where
6+
7+import Control.Applicative
8+import Control.Monad.IO.Class
9+import Data.Aeson
10+import Data.Char
11+import Data.List
12+import GHC.Generics
13+import qualified Language.Javascript.JQuery as JQ
14+import Math.Probable
15+import Network.Wai
16+import Servant
17+import Servant.JQuery
18+
19+data Point = Point
20+ { x :: Double
21+ , y :: Double
22+ } deriving Generic
23+
24+instance ToJSON Point
25+
26+randomPoint :: MonadIO m => m Point
27+randomPoint = liftIO . mwc $ Point <$> d <*> d
28+
29+ where d = doubleIn (-1, 1)
30+
31+data Search a = Search
32+ { query :: String
33+ , results :: [a]
34+ } deriving Generic
35+
36+mkSearch :: String -> [a] -> Search a
37+mkSearch = Search
38+
39+instance ToJSON a => ToJSON (Search a)
40+
41+data Book = Book
42+ { author :: String
43+ , title :: String
44+ , year :: Int
45+ } deriving Generic
46+
47+instance ToJSON Book
48+
49+book :: String -> String -> Int -> Book
50+book = Book
51+
52+books :: [Book]
53+books =
54+ [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
55+ , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
56+ , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
57+ , book "Graham Hutton" "Programming in Haskell" 2007
58+ , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
59+ , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
60+ ]
61+
62+searchBook :: Monad m => Maybe String -> m (Search Book)
63+searchBook Nothing = return (mkSearch "" books)
64+searchBook (Just q) = return (mkSearch q books')
65+
66+ where books' = filter (\b -> q' `isInfixOf` map toLower (author b)
67+ || q' `isInfixOf` map toLower (title b)
68+ )
69+ books
70+ q' = map toLower q
71+
72+type API = "point" :> Get '[JSON] Point
73+ :<|> "books" :> QueryParam "q" String :> Get '[JSON] (Search Book)
74+
75+type API' = API :<|> Raw
76+
77+api :: Proxy API
78+api = Proxy
79+
80+api' :: Proxy API'
81+api' = Proxy
82+
83+server :: Server API
84+server = randomPoint
85+ :<|> searchBook
86+
87+server' :: Server API'
88+server' = server
89+ :<|> serveDirectory "getting-started/gs9"
90+
91+apiJS :: String
92+apiJS = jsForAPI api
93+
94+writeJSFiles :: IO ()
95+writeJSFiles = do
96+ writeFile "getting-started/gs9/api.js" apiJS
97+ jq <- readFile =<< JQ.file
98+ writeFile "getting-started/gs9/jq.js" jq
99+
100+app :: Application
101+app = serve api' server'
servant-examples/getting-started/getting-started.hs+14−12
@@ -9,24 +9,26 @@ import qualified GS4
9import qualified GS5
9import qualified GS5
10import qualified GS6
10import qualified GS6
11import qualified GS7
11import qualified GS7
12+import qualified GS9
12
13
13−app :: String -> Maybe Application
14+app :: String -> (Application -> IO ()) -> IO ()
14−app n = case n of
15+app n f = case n of
15− "1" -> Just GS1.app
16+ "1" -> f GS1.app
16− "2" -> Just GS2.app
17+ "2" -> f GS2.app
17− "3" -> Just GS3.app
18+ "3" -> f GS3.app
18− "4" -> Just GS4.app
19+ "4" -> f GS4.app
19− "5" -> Just GS5.app
20+ "5" -> f GS5.app
20− "6" -> Just GS6.app
21+ "6" -> f GS6.app
21− "7" -> Just GS7.app
22+ "7" -> f GS7.app
22− "8" -> Just GS3.app
23+ "8" -> f GS3.app
23− _ -> Nothing
24+ "9" -> GS9.writeJSFiles >> f GS9.app
25+ _ -> usage
24
26
25main :: IO ()
27main :: IO ()
26main = do
28main = do
27 args <- getArgs
29 args <- getArgs
28 case args of
30 case args of
29− [n] -> maybe usage (run 8081) (app n)
31+ [n] -> app n (run 8081)
30 _ -> usage
32 _ -> usage
31
33
32usage :: IO ()
34usage :: IO ()
servant-examples/getting-started/gs9/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>Getting started - 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/getting-started/gs9/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/servant-examples.cabal+4−1
@@ -15,14 +15,17 @@ cabal-version: >=1.10
15
15
16executable getting-started
16executable getting-started
17 main-is: getting-started.hs
17 main-is: getting-started.hs
18− other-modules: GS1, GS2
18+ other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9
19 build-depends:
19 build-depends:
20 aeson >= 0.8
20 aeson >= 0.8
21 , base >= 4.7
21 , base >= 4.7
22 , directory
22 , directory
23 , either
23 , either
24+ , js-jquery
24 , lucid
25 , lucid
26+ , probable
25 , servant
27 , servant
28+ , servant-jquery
26 , servant-lucid
29 , servant-lucid
27 , servant-server
30 , servant-server
28 , time
31 , time