Remove servant-examples

This commit is contained in:
Julian K. Arni 2016-01-27 22:04:13 +01:00 committed by Sönke Hahn
parent db602e8a79
commit 62fffed1f1
19 changed files with 0 additions and 707 deletions

View file

@ -1 +0,0 @@
../servant-examples/tutorial

View file

@ -1,30 +0,0 @@
Copyright (c) 2015-2016, Servant Contributors
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Alp Mestanogullari nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View file

@ -1,2 +0,0 @@
import Distribution.Simple
main = defaultMain

View file

@ -1,90 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.Aeson
import Data.Monoid
import Data.Proxy
import Data.Text (Text)
import GHC.Generics
import Network.HTTP.Client (Manager, defaultManagerSettings,
newManager)
import System.IO.Unsafe (unsafePerformIO)
import Servant.API
import Servant.Client
import qualified Data.Text as T
import qualified Data.Text.IO as T
type HackageAPI =
"users" :> Get '[JSON] [UserSummary]
:<|> "user" :> Capture "username" Username :> Get '[JSON] UserDetailed
:<|> "packages" :> Get '[JSON] [Package]
type Username = Text
data UserSummary = UserSummary
{ summaryUsername :: Username
, summaryUserid :: Int
} deriving (Eq, Show)
instance FromJSON UserSummary where
parseJSON (Object o) =
UserSummary <$> o .: "username"
<*> o .: "userid"
parseJSON _ = mzero
type Group = Text
data UserDetailed = UserDetailed
{ username :: Username
, userid :: Int
, groups :: [Group]
} deriving (Eq, Show, Generic)
instance FromJSON UserDetailed
newtype Package = Package { packageName :: Text }
deriving (Eq, Show, Generic)
instance FromJSON Package
hackageAPI :: Proxy HackageAPI
hackageAPI = Proxy
{-# NOINLINE manager #-}
manager :: Manager
manager = unsafePerformIO $ newManager defaultManagerSettings
getUsers :: ExceptT ServantError IO [UserSummary]
getUser :: Username -> ExceptT ServantError IO UserDetailed
getPackages :: ExceptT ServantError IO [Package]
getUsers :<|> getUser :<|> getPackages =
client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
main :: IO ()
main = print =<< uselessNumbers
uselessNumbers :: IO (Either ServantError ())
uselessNumbers = runExceptT $ do
users <- getUsers
liftIO . putStrLn $ show (length users) ++ " users"
user <- liftIO $ do
putStrLn "Enter a valid hackage username"
T.getLine
userDetailed <- getUser user
liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
packages <- getPackages
let monadPackages = filter (isMonadPackage . packageName) packages
liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
where isMonadPackage = T.isInfixOf "monad"

View file

@ -1,8 +0,0 @@
#if __GLASGOW_HASKELL__ >= 710
#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
#define OVERLAPPING_ {-# OVERLAPPING #-}
#else
{-# LANGUAGE OverlappingInstances #-}
#define OVERLAPPABLE_
#define OVERLAPPING_
#endif

View file

@ -1,109 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
module Chat (eioServer, ServerState (..)) where
import Prelude hiding (mapM_)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), pure)
#endif
import Control.Monad.State.Class (MonadState)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson ((.=))
import Data.Foldable (mapM_)
import qualified Control.Concurrent.STM as STM
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Network.SocketIO as SocketIO
data AddUser = AddUser Text.Text
instance Aeson.FromJSON AddUser where
parseJSON = Aeson.withText "AddUser" $ pure . AddUser
data NumConnected = NumConnected !Int
instance Aeson.ToJSON NumConnected where
toJSON (NumConnected n) = Aeson.object [ "numUsers" .= n]
data NewMessage = NewMessage Text.Text
instance Aeson.FromJSON NewMessage where
parseJSON = Aeson.withText "NewMessage" $ pure . NewMessage
data Said = Said Text.Text Text.Text
instance Aeson.ToJSON Said where
toJSON (Said username message) = Aeson.object
[ "username" .= username
, "message" .= message
]
data UserName = UserName Text.Text
instance Aeson.ToJSON UserName where
toJSON (UserName un) = Aeson.object [ "username" .= un ]
data UserJoined = UserJoined Text.Text Int
instance Aeson.ToJSON UserJoined where
toJSON (UserJoined un n) = Aeson.object
[ "username" .= un
, "numUsers" .= n
]
--------------------------------------------------------------------------------
data ServerState = ServerState { ssNConnected :: STM.TVar Int }
--server :: ServerState -> StateT SocketIO.RoutingTable Snap.Snap ()
eioServer :: forall (m :: * -> *). (MonadState SocketIO.RoutingTable m, MonadIO m) => ServerState -> m ()
eioServer state = do
userNameMVar <- liftIO STM.newEmptyTMVarIO
let forUserName m = liftIO (STM.atomically (STM.tryReadTMVar userNameMVar)) >>= mapM_ m
SocketIO.on "new message" $ \(NewMessage message) ->
forUserName $ \userName ->
SocketIO.broadcast "new message" (Said userName message)
SocketIO.on "add user" $ \(AddUser userName) -> do
n <- liftIO $ STM.atomically $ do
n <- (+ 1) <$> STM.readTVar (ssNConnected state)
STM.putTMVar userNameMVar userName
STM.writeTVar (ssNConnected state) n
return n
SocketIO.emit "login" (NumConnected n)
SocketIO.broadcast "user joined" (UserJoined userName n)
SocketIO.appendDisconnectHandler $ do
(n, mUserName) <- liftIO $ STM.atomically $ do
n <- (+ (-1)) <$> STM.readTVar (ssNConnected state)
mUserName <- STM.tryReadTMVar userNameMVar
STM.writeTVar (ssNConnected state) n
return (n, mUserName)
case mUserName of
Nothing -> return ()
Just userName ->
SocketIO.broadcast "user left" (UserJoined userName n)
SocketIO.on "typing" $
forUserName $ \userName ->
SocketIO.broadcast "typing" (UserName userName)
SocketIO.on "stop typing" $
forUserName $ \userName ->
SocketIO.broadcast "stop typing" (UserName userName)

View file

@ -1,28 +0,0 @@
<!doctype html>
<html lang="en">
<head>
<meta charset="UTF-8">
<title>Socket.IO Chat Example</title>
<link rel="stylesheet" href="style.css">
</head>
<body>
<ul class="pages">
<li class="chat page">
<div class="chatArea">
<ul class="messages"></ul>
</div>
<input class="inputMessage" placeholder="Type here..."/>
</li>
<li class="login page">
<div class="form">
<h3 class="title">What's your nickname?</h3>
<input class="usernameInput" type="text" maxlength="14" />
</div>
</li>
</ul>
<script src="https://cdn.socket.io/socket.io-1.2.1.js"></script>
<script src="https://code.jquery.com/jquery-1.10.2.min.js"></script>
<script src="/main.js"></script>
</body>
</html>

View file

@ -1,274 +0,0 @@
$(function() {
var FADE_TIME = 150; // ms
var TYPING_TIMER_LENGTH = 400; // ms
var COLORS = [
'#e21400', '#91580f', '#f8a700', '#f78b00',
'#58dc00', '#287b00', '#a8f07a', '#4ae8c4',
'#3b88eb', '#3824aa', '#a700ff', '#d300e7'
];
// Initialize varibles
var $window = $(window);
var $usernameInput = $('.usernameInput'); // Input for username
var $messages = $('.messages'); // Messages area
var $inputMessage = $('.inputMessage'); // Input message input box
var $loginPage = $('.login.page'); // The login page
var $chatPage = $('.chat.page'); // The chatroom page
// Prompt for setting a username
var username;
var connected = false;
var typing = false;
var lastTypingTime;
var $currentInput = $usernameInput.focus();
var socket = io();
function addParticipantsMessage (data) {
var message = '';
if (data.numUsers === 1) {
message += "there's 1 participant";
} else {
message += "there're " + data.numUsers + " participants";
}
log(message);
}
// Sets the client's username
function setUsername () {
username = cleanInput($usernameInput.val().trim());
// If the username is valid
if (username) {
$loginPage.fadeOut();
$chatPage.show();
$loginPage.off('click');
$currentInput = $inputMessage.focus();
// Tell the server your username
socket.emit('add user', username);
}
}
// Sends a chat message
function sendMessage () {
var message = $inputMessage.val();
// Prevent markup from being injected into the message
message = cleanInput(message);
// if there is a non-empty message and a socket connection
if (message && connected) {
$inputMessage.val('');
addChatMessage({
username: username,
message: message
});
// tell server to execute 'new message' and send along one parameter
socket.emit('new message', message);
}
}
// Log a message
function log (message, options) {
var $el = $('<li>').addClass('log').text(message);
addMessageElement($el, options);
}
// Adds the visual chat message to the message list
function addChatMessage (data, options) {
// Don't fade the message in if there is an 'X was typing'
var $typingMessages = getTypingMessages(data);
options = options || {};
if ($typingMessages.length !== 0) {
options.fade = false;
$typingMessages.remove();
}
var $usernameDiv = $('<span class="username"/>')
.text(data.username)
.css('color', getUsernameColor(data.username));
var $messageBodyDiv = $('<span class="messageBody">')
.text(data.message);
var typingClass = data.typing ? 'typing' : '';
var $messageDiv = $('<li class="message"/>')
.data('username', data.username)
.addClass(typingClass)
.append($usernameDiv, $messageBodyDiv);
addMessageElement($messageDiv, options);
}
// Adds the visual chat typing message
function addChatTyping (data) {
data.typing = true;
data.message = 'is typing';
addChatMessage(data);
}
// Removes the visual chat typing message
function removeChatTyping (data) {
getTypingMessages(data).fadeOut(function () {
$(this).remove();
});
}
// Adds a message element to the messages and scrolls to the bottom
// el - The element to add as a message
// options.fade - If the element should fade-in (default = true)
// options.prepend - If the element should prepend
// all other messages (default = false)
function addMessageElement (el, options) {
var $el = $(el);
// Setup default options
if (!options) {
options = {};
}
if (typeof options.fade === 'undefined') {
options.fade = true;
}
if (typeof options.prepend === 'undefined') {
options.prepend = false;
}
// Apply options
if (options.fade) {
$el.hide().fadeIn(FADE_TIME);
}
if (options.prepend) {
$messages.prepend($el);
} else {
$messages.append($el);
}
$messages[0].scrollTop = $messages[0].scrollHeight;
}
// Prevents input from having injected markup
function cleanInput (input) {
return $('<div/>').text(input).text();
}
// Updates the typing event
function updateTyping () {
if (connected) {
if (!typing) {
typing = true;
socket.emit('typing');
}
lastTypingTime = (new Date()).getTime();
setTimeout(function () {
var typingTimer = (new Date()).getTime();
var timeDiff = typingTimer - lastTypingTime;
if (timeDiff >= TYPING_TIMER_LENGTH && typing) {
socket.emit('stop typing');
typing = false;
}
}, TYPING_TIMER_LENGTH);
}
}
// Gets the 'X is typing' messages of a user
function getTypingMessages (data) {
return $('.typing.message').filter(function (i) {
return $(this).data('username') === data.username;
});
}
// Gets the color of a username through our hash function
function getUsernameColor (username) {
// Compute hash code
var hash = 7;
for (var i = 0; i < username.length; i++) {
hash = username.charCodeAt(i) + (hash << 5) - hash;
}
// Calculate color
var index = Math.abs(hash % COLORS.length);
return COLORS[index];
}
// Keyboard events
$window.keydown(function (event) {
// Auto-focus the current input when a key is typed
if (!(event.ctrlKey || event.metaKey || event.altKey)) {
$currentInput.focus();
}
// When the client hits ENTER on their keyboard
if (event.which === 13) {
if (username) {
sendMessage();
socket.emit('stop typing');
typing = false;
} else {
setUsername();
}
}
});
$inputMessage.on('input', function() {
updateTyping();
});
// Click events
// Focus input when clicking anywhere on login page
$loginPage.click(function () {
$currentInput.focus();
});
// Focus input when clicking on the message input's border
$inputMessage.click(function () {
$inputMessage.focus();
});
// Socket events
socket.on('connected', function (data) {
console.log('connected:', data);
});
// Socket events
socket.on('changes', function (data) {
console.log('changes:', data);
});
// Whenever the server emits 'login', log the login message
socket.on('login', function (data) {
connected = true;
// Display the welcome message
var message = "Welcome to Socket.IO Chat &mdash; ";
log(message, {
prepend: true
});
addParticipantsMessage(data);
});
// Whenever the server emits 'new message', update the chat body
socket.on('new message', function (data) {
addChatMessage(data);
});
// Whenever the server emits 'user joined', log it in the chat body
socket.on('user joined', function (data) {
log(data.username + ' joined');
addParticipantsMessage(data);
});
// Whenever the server emits 'user left', log it in the chat body
socket.on('user left', function (data) {
log(data.username + ' left');
addParticipantsMessage(data);
removeChatTyping(data);
});
// Whenever the server emits 'typing', show the typing message
socket.on('typing', function (data) {
addChatTyping(data);
});
// Whenever the server emits 'stop typing', kill the typing message
socket.on('stop typing', function (data) {
removeChatTyping(data);
});
});

View file

@ -1,150 +0,0 @@
/* Fix user-agent */
* {
box-sizing: border-box;
}
html {
font-weight: 300;
-webkit-font-smoothing: antialiased;
}
html, input {
font-family:
"HelveticaNeue-Light",
"Helvetica Neue Light",
"Helvetica Neue",
Helvetica,
Arial,
"Lucida Grande",
sans-serif;
}
html, body {
height: 100%;
margin: 0;
padding: 0;
}
ul {
list-style: none;
word-wrap: break-word;
}
/* Pages */
.pages {
height: 100%;
margin: 0;
padding: 0;
width: 100%;
}
.page {
height: 100%;
position: absolute;
width: 100%;
}
/* Login Page */
.login.page {
background-color: #000;
}
.login.page .form {
height: 100px;
margin-top: -100px;
position: absolute;
text-align: center;
top: 50%;
width: 100%;
}
.login.page .form .usernameInput {
background-color: transparent;
border: none;
border-bottom: 2px solid #fff;
outline: none;
padding-bottom: 15px;
text-align: center;
width: 400px;
}
.login.page .title {
font-size: 200%;
}
.login.page .usernameInput {
font-size: 200%;
letter-spacing: 3px;
}
.login.page .title, .login.page .usernameInput {
color: #fff;
font-weight: 100;
}
/* Chat page */
.chat.page {
display: none;
}
/* Font */
.messages {
font-size: 150%;
}
.inputMessage {
font-size: 100%;
}
.log {
color: gray;
font-size: 70%;
margin: 5px;
text-align: center;
}
/* Messages */
.chatArea {
height: 100%;
padding-bottom: 60px;
}
.messages {
height: 100%;
margin: 0;
overflow-y: scroll;
padding: 10px 20px 10px 20px;
}
.message.typing .messageBody {
color: gray;
}
.username {
float: left;
font-weight: 700;
overflow: hidden;
padding-right: 15px;
text-align: right;
}
/* Input */
.inputMessage {
border: 10px solid #000;
bottom: 0;
height: 60px;
left: 0;
outline: none;
padding-left: 10px;
position: absolute;
right: 0;
width: 100%;
}

View file

@ -1,15 +0,0 @@
dependencies:
- name: servant
path: ../servant
- name: servant-server
path: ../servant-server
- name: servant-client
path: ../servant-client
- name: servant-js
path: ../servant-js
- name: servant-lucid
path: ../servant-lucid
- name: servant-docs
path: ../servant-docs
- name: servant-foreign
path: ../servant-foreign