examples: add GS9
This commit is contained in:
Alp Mestanogullari
parent
0000189760
commit
77b15e9cdc
5 changed files with 206 additions and 13 deletions
101
servant-examples/getting-started/GS9.hs
Normal file
101
servant-examples/getting-started/GS9.hs
Normal file
|
|
@ -0,0 +1,101 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
module GS9 where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.Char
|
||||||
|
import Data.List
|
||||||
|
import GHC.Generics
|
||||||
|
import qualified Language.Javascript.JQuery as JQ
|
||||||
|
import Math.Probable
|
||||||
|
import Network.Wai
|
||||||
|
import Servant
|
||||||
|
import Servant.JQuery
|
||||||
|
|
||||||
|
data Point = Point
|
||||||
|
{ x :: Double
|
||||||
|
, y :: Double
|
||||||
|
} deriving Generic
|
||||||
|
|
||||||
|
instance ToJSON Point
|
||||||
|
|
||||||
|
randomPoint :: MonadIO m => m Point
|
||||||
|
randomPoint = liftIO . mwc $ Point <$> d <*> d
|
||||||
|
|
||||||
|
where d = doubleIn (-1, 1)
|
||||||
|
|
||||||
|
data Search a = Search
|
||||||
|
{ query :: String
|
||||||
|
, results :: [a]
|
||||||
|
} deriving Generic
|
||||||
|
|
||||||
|
mkSearch :: String -> [a] -> Search a
|
||||||
|
mkSearch = Search
|
||||||
|
|
||||||
|
instance ToJSON a => ToJSON (Search a)
|
||||||
|
|
||||||
|
data Book = Book
|
||||||
|
{ author :: String
|
||||||
|
, title :: String
|
||||||
|
, year :: Int
|
||||||
|
} deriving Generic
|
||||||
|
|
||||||
|
instance ToJSON Book
|
||||||
|
|
||||||
|
book :: String -> String -> Int -> Book
|
||||||
|
book = Book
|
||||||
|
|
||||||
|
books :: [Book]
|
||||||
|
books =
|
||||||
|
[ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
|
||||||
|
, book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
|
||||||
|
, book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
|
||||||
|
, book "Graham Hutton" "Programming in Haskell" 2007
|
||||||
|
, book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
|
||||||
|
, book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
|
||||||
|
]
|
||||||
|
|
||||||
|
searchBook :: Monad m => Maybe String -> 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)
|
||||||
|
)
|
||||||
|
books
|
||||||
|
q' = map toLower q
|
||||||
|
|
||||||
|
type API = "point" :> Get '[JSON] Point
|
||||||
|
:<|> "books" :> QueryParam "q" String :> Get '[JSON] (Search Book)
|
||||||
|
|
||||||
|
type API' = API :<|> Raw
|
||||||
|
|
||||||
|
api :: Proxy API
|
||||||
|
api = Proxy
|
||||||
|
|
||||||
|
api' :: Proxy API'
|
||||||
|
api' = Proxy
|
||||||
|
|
||||||
|
server :: Server API
|
||||||
|
server = randomPoint
|
||||||
|
:<|> searchBook
|
||||||
|
|
||||||
|
server' :: Server API'
|
||||||
|
server' = server
|
||||||
|
:<|> serveDirectory "getting-started/gs9"
|
||||||
|
|
||||||
|
apiJS :: String
|
||||||
|
apiJS = jsForAPI api
|
||||||
|
|
||||||
|
writeJSFiles :: IO ()
|
||||||
|
writeJSFiles = do
|
||||||
|
writeFile "getting-started/gs9/api.js" apiJS
|
||||||
|
jq <- readFile =<< JQ.file
|
||||||
|
writeFile "getting-started/gs9/jq.js" jq
|
||||||
|
|
||||||
|
app :: Application
|
||||||
|
app = serve api' server'
|
||||||
|
|
@ -9,24 +9,26 @@ import qualified GS4
|
||||||
import qualified GS5
|
import qualified GS5
|
||||||
import qualified GS6
|
import qualified GS6
|
||||||
import qualified GS7
|
import qualified GS7
|
||||||
|
import qualified GS9
|
||||||
|
|
||||||
app :: String -> Maybe Application
|
app :: String -> (Application -> IO ()) -> IO ()
|
||||||
app n = case n of
|
app n f = case n of
|
||||||
"1" -> Just GS1.app
|
"1" -> f GS1.app
|
||||||
"2" -> Just GS2.app
|
"2" -> f GS2.app
|
||||||
"3" -> Just GS3.app
|
"3" -> f GS3.app
|
||||||
"4" -> Just GS4.app
|
"4" -> f GS4.app
|
||||||
"5" -> Just GS5.app
|
"5" -> f GS5.app
|
||||||
"6" -> Just GS6.app
|
"6" -> f GS6.app
|
||||||
"7" -> Just GS7.app
|
"7" -> f GS7.app
|
||||||
"8" -> Just GS3.app
|
"8" -> f GS3.app
|
||||||
_ -> Nothing
|
"9" -> GS9.writeJSFiles >> f GS9.app
|
||||||
|
_ -> usage
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
case args of
|
case args of
|
||||||
[n] -> maybe usage (run 8081) (app n)
|
[n] -> app n (run 8081)
|
||||||
_ -> usage
|
_ -> usage
|
||||||
|
|
||||||
usage :: IO ()
|
usage :: IO ()
|
||||||
|
|
|
||||||
26
servant-examples/getting-started/gs9/index.html
Normal file
26
servant-examples/getting-started/gs9/index.html
Normal file
|
|
@ -0,0 +1,26 @@
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<html lang="en">
|
||||||
|
<head>
|
||||||
|
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||||
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
|
||||||
|
<title>Getting started - 9 - servant-jquery</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<h1>Books</h1>
|
||||||
|
<input type="search" name="q" id="q" placeholder="Search author or book title..." />
|
||||||
|
<div>
|
||||||
|
<p>Results for <strong id="query">""</strong></p>
|
||||||
|
<ul id="results">
|
||||||
|
</ul>
|
||||||
|
</div>
|
||||||
|
<hr />
|
||||||
|
<h1>Approximating π</h1>
|
||||||
|
<p>Count: <span id="count">0</span></p>
|
||||||
|
<p>Successes: <span id="successes">0</span></p>
|
||||||
|
<p id="pi"></p>
|
||||||
|
|
||||||
|
<script type="text/javascript" src="/jq.js"></script>
|
||||||
|
<script type="text/javascript" src="/api.js"></script>
|
||||||
|
<script type="text/javascript" src="/ui.js"></script>
|
||||||
|
|
||||||
|
</body>
|
||||||
61
servant-examples/getting-started/gs9/ui.js
Normal file
61
servant-examples/getting-started/gs9/ui.js
Normal file
|
|
@ -0,0 +1,61 @@
|
||||||
|
/* book search */
|
||||||
|
function updateResults(data)
|
||||||
|
{
|
||||||
|
console.log(data);
|
||||||
|
$('#results').html("");
|
||||||
|
$('#query').text("\"" + data.query + "\"");
|
||||||
|
for(var i = 0; i < data.results.length; i++)
|
||||||
|
{
|
||||||
|
$('#results').append(renderBook(data.results[i]));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
function renderBook(book)
|
||||||
|
{
|
||||||
|
var li = '<li><strong>' + book.title + '</strong>, <i>'
|
||||||
|
+ book.author + '</i> - ' + book.year + '</li>';
|
||||||
|
return li;
|
||||||
|
}
|
||||||
|
|
||||||
|
function searchBooks()
|
||||||
|
{
|
||||||
|
var q = $('#q').val();
|
||||||
|
getbooks(q, updateResults, console.log)
|
||||||
|
}
|
||||||
|
|
||||||
|
searchBooks();
|
||||||
|
$('#q').keyup(function() {
|
||||||
|
searchBooks();
|
||||||
|
});
|
||||||
|
|
||||||
|
/* approximating pi */
|
||||||
|
var count = 0;
|
||||||
|
var successes = 0;
|
||||||
|
|
||||||
|
function f(data)
|
||||||
|
{
|
||||||
|
var x = data.x, y = data.y;
|
||||||
|
if(x*x + y*y <= 1)
|
||||||
|
{
|
||||||
|
successes++;
|
||||||
|
}
|
||||||
|
|
||||||
|
count++;
|
||||||
|
|
||||||
|
update('#count', count);
|
||||||
|
update('#successes', successes);
|
||||||
|
update('#pi', 4*successes/count);
|
||||||
|
}
|
||||||
|
|
||||||
|
function update(id, val)
|
||||||
|
{
|
||||||
|
$(id).text(val);
|
||||||
|
}
|
||||||
|
|
||||||
|
function refresh()
|
||||||
|
{
|
||||||
|
getpoint(f, console.log);
|
||||||
|
}
|
||||||
|
|
||||||
|
window.setInterval(refresh, 200);
|
||||||
|
|
||||||
|
|
@ -15,14 +15,17 @@ cabal-version: >=1.10
|
||||||
|
|
||||||
executable getting-started
|
executable getting-started
|
||||||
main-is: getting-started.hs
|
main-is: getting-started.hs
|
||||||
other-modules: GS1, GS2
|
other-modules: GS1, GS2, GS3, GS4, GS5, GS6, GS7, GS8, GS9
|
||||||
build-depends:
|
build-depends:
|
||||||
aeson >= 0.8
|
aeson >= 0.8
|
||||||
, base >= 4.7
|
, base >= 4.7
|
||||||
, directory
|
, directory
|
||||||
, either
|
, either
|
||||||
|
, js-jquery
|
||||||
, lucid
|
, lucid
|
||||||
|
, probable
|
||||||
, servant
|
, servant
|
||||||
|
, servant-jquery
|
||||||
, servant-lucid
|
, servant-lucid
|
||||||
, servant-server
|
, servant-server
|
||||||
, time
|
, time
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue