diff --git a/doc/tutorial b/doc/tutorial deleted file mode 120000 index 6072fcb4..00000000 --- a/doc/tutorial +++ /dev/null @@ -1 +0,0 @@ -../servant-examples/tutorial \ No newline at end of file diff --git a/servant-examples/tutorial/api-type.lhs b/doc/tutorial/api-type.lhs similarity index 100% rename from servant-examples/tutorial/api-type.lhs rename to doc/tutorial/api-type.lhs diff --git a/servant-examples/tutorial/check/check.sh b/doc/tutorial/check/check.sh similarity index 100% rename from servant-examples/tutorial/check/check.sh rename to doc/tutorial/check/check.sh diff --git a/servant-examples/tutorial/check/tinc.yaml b/doc/tutorial/check/tinc.yaml similarity index 100% rename from servant-examples/tutorial/check/tinc.yaml rename to doc/tutorial/check/tinc.yaml diff --git a/servant-examples/tutorial/client.lhs b/doc/tutorial/client.lhs similarity index 100% rename from servant-examples/tutorial/client.lhs rename to doc/tutorial/client.lhs diff --git a/servant-examples/tutorial/convert.hs b/doc/tutorial/convert.hs similarity index 100% rename from servant-examples/tutorial/convert.hs rename to doc/tutorial/convert.hs diff --git a/servant-examples/tutorial/docs.lhs b/doc/tutorial/docs.lhs similarity index 100% rename from servant-examples/tutorial/docs.lhs rename to doc/tutorial/docs.lhs diff --git a/servant-examples/tutorial/index.rst b/doc/tutorial/index.rst similarity index 100% rename from servant-examples/tutorial/index.rst rename to doc/tutorial/index.rst diff --git a/servant-examples/tutorial/javascript.lhs b/doc/tutorial/javascript.lhs similarity index 100% rename from servant-examples/tutorial/javascript.lhs rename to doc/tutorial/javascript.lhs diff --git a/servant-examples/tutorial/server.lhs b/doc/tutorial/server.lhs similarity index 100% rename from servant-examples/tutorial/server.lhs rename to doc/tutorial/server.lhs diff --git a/servant-examples/LICENSE b/servant-examples/LICENSE deleted file mode 100644 index 68d30586..00000000 --- a/servant-examples/LICENSE +++ /dev/null @@ -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. diff --git a/servant-examples/Setup.hs b/servant-examples/Setup.hs deleted file mode 100644 index 44671092..00000000 --- a/servant-examples/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/servant-examples/auth-combinator/auth-combinator.hs b/servant-examples/auth-combinator/auth-combinator.hs deleted file mode 100644 index f2cebb4f..00000000 --- a/servant-examples/auth-combinator/auth-combinator.hs +++ /dev/null @@ -1,96 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} - -import Data.Aeson -import Data.ByteString (ByteString) -import Data.IORef -import Data.Text (Text) -import GHC.Generics -import Network.Wai -import Network.Wai.Handler.Warp -import Servant -import Servant.Server.Internal - --- Pretty much stolen/adapted from --- https://github.com/haskell-servant/HaskellSGMeetup2015/blob/master/examples/authentication-combinator/AuthenticationCombinator.hs - -type DBConnection = IORef [ByteString] -type DBLookup = DBConnection -> ByteString -> IO Bool - -initDB :: IO DBConnection -initDB = newIORef ["good password"] - -isGoodCookie :: DBLookup -isGoodCookie ref password = do - allowed <- readIORef ref - return (password `elem` allowed) - -data AuthProtected - -instance (HasConfigEntry config DBConnection, HasServer rest config) - => HasServer (AuthProtected :> rest) config where - - type ServerT (AuthProtected :> rest) m = ServerT rest m - - route Proxy config subserver = WithRequest $ \ request -> - route (Proxy :: Proxy rest) config $ addAcceptCheck subserver $ cookieCheck request - where - cookieCheck req = case lookup "Cookie" (requestHeaders req) of - Nothing -> return $ FailFatal err401 { errBody = "Missing auth header" } - Just v -> do - let dbConnection = getConfigEntry config - authGranted <- isGoodCookie dbConnection v - if authGranted - then return $ Route () - else return $ FailFatal err403 { errBody = "Invalid cookie" } - -type PrivateAPI = Get '[JSON] [PrivateData] - -type PublicAPI = Get '[JSON] [PublicData] - -type API = "private" :> AuthProtected :> PrivateAPI - :<|> PublicAPI - -newtype PrivateData = PrivateData { ssshhh :: Text } - deriving (Eq, Show, Generic) - -instance ToJSON PrivateData - -newtype PublicData = PublicData { somedata :: Text } - deriving (Eq, Show, Generic) - -instance ToJSON PublicData - -api :: Proxy API -api = Proxy - -server :: Server API -server = return prvdata :<|> return pubdata - - where prvdata = [PrivateData "this is a secret"] - pubdata = [PublicData "this is a public piece of data"] - -main :: IO () -main = do - dbConnection <- initDB - let config = dbConnection :. EmptyConfig - run 8080 (serve api config server) - -{- Sample session: -$ curl http://localhost:8080/ -[{"somedata":"this is a public piece of data"}] -$ curl http://localhost:8080/private -Missing auth header. -$ curl -H "Cookie: good password" http://localhost:8080/private -[{"ssshhh":"this is a secret"}] -$ curl -H "Cookie: bad password" http://localhost:8080/private -Invalid cookie. --} diff --git a/servant-examples/hackage/hackage.hs b/servant-examples/hackage/hackage.hs deleted file mode 100644 index 4d29b556..00000000 --- a/servant-examples/hackage/hackage.hs +++ /dev/null @@ -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" diff --git a/servant-examples/include/overlapping-compat.h b/servant-examples/include/overlapping-compat.h deleted file mode 100644 index eef9d4ea..00000000 --- a/servant-examples/include/overlapping-compat.h +++ /dev/null @@ -1,8 +0,0 @@ -#if __GLASGOW_HASKELL__ >= 710 -#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} -#define OVERLAPPING_ {-# OVERLAPPING #-} -#else -{-# LANGUAGE OverlappingInstances #-} -#define OVERLAPPABLE_ -#define OVERLAPPING_ -#endif diff --git a/servant-examples/servant-examples.cabal b/servant-examples/servant-examples.cabal deleted file mode 100644 index d62c01c7..00000000 --- a/servant-examples/servant-examples.cabal +++ /dev/null @@ -1,130 +0,0 @@ -name: servant-examples -version: 0.5 -synopsis: Example programs for servant -description: Example programs for servant, - showcasing solutions to common needs. -homepage: http://haskell-servant.github.io/ -license: BSD3 -license-file: LICENSE -author: Servant Contributors -maintainer: haskell-servant-maintainers@googlegroups.com -copyright: 2015-2016 Servant Contributors -category: Web -build-type: Simple -cabal-version: >=1.10 -bug-reports: http://github.com/haskell-servant/servant/issues -source-repository head - type: git - location: http://github.com/haskell-servant/servant.git - -executable tutorial - main-is: tutorial.hs - other-modules: T1, T2, T3, T4, T5, T6, T7, T8, T9, T10 - ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-unused-imports - build-depends: - aeson >= 0.8 - , base >= 4.7 && < 5 - , bytestring - , directory - , http-types - , js-jquery - , lucid - , random - , servant == 0.5.* - , servant-docs == 0.5.* - , servant-js == 0.5.* - , servant-lucid == 0.5.* - , servant-server == 0.5.* - , text - , time - , transformers - , transformers-compat - , wai - , warp - hs-source-dirs: tutorial - default-language: Haskell2010 - -executable t8-main - main-is: t8-main.hs - other-modules: T3, T8 - hs-source-dirs: tutorial - default-language: Haskell2010 - ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing - build-depends: - aeson - , base >= 4.7 && < 5 - , http-client > 0.4 && < 0.5 - , servant == 0.5.* - , servant-client == 0.5.* - , servant-server == 0.5.* - , transformers - , transformers-compat - , wai - -executable hackage - main-is: hackage.hs - build-depends: - aeson >= 0.8 - , base >=4.7 && < 5 - , http-client > 0.4 && < 0.5 - , servant == 0.5.* - , servant-client == 0.5.* - , text - , transformers - , transformers-compat - hs-source-dirs: hackage - default-language: Haskell2010 - -executable wai-middleware - main-is: wai-middleware.hs - build-depends: - aeson >= 0.8 - , base >= 4.7 && < 5 - , servant == 0.5.* - , servant-server == 0.5.* - , text - , wai - , wai-extra - , warp - hs-source-dirs: wai-middleware - default-language: Haskell2010 - -executable auth-combinator - main-is: auth-combinator.hs - ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing - build-depends: - aeson >= 0.8 - , base >= 4.7 && < 5 - , bytestring - , http-types - , servant == 0.5.* - , servant-server == 0.5.* - , text - , wai - , warp - hs-source-dirs: auth-combinator - default-language: Haskell2010 - -executable socket-io-chat - main-is: socket-io-chat.hs - ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing - other-modules: Chat - build-depends: - aeson >= 0.8 - , base >= 4.7 && < 5 - , bytestring - , http-types - , servant == 0.5.* - , servant-server == 0.5.* - , socket-io - , engine-io - , engine-io-wai - , text - , wai - , warp - , transformers - , stm - , mtl - ghc-options: -Wall -O2 -threaded - hs-source-dirs: socket-io-chat - default-language: Haskell2010 diff --git a/servant-examples/socket-io-chat/Chat.hs b/servant-examples/socket-io-chat/Chat.hs deleted file mode 100644 index 9f2faa92..00000000 --- a/servant-examples/socket-io-chat/Chat.hs +++ /dev/null @@ -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) - diff --git a/servant-examples/socket-io-chat/resources/index.html b/servant-examples/socket-io-chat/resources/index.html deleted file mode 100644 index 92b055ff..00000000 --- a/servant-examples/socket-io-chat/resources/index.html +++ /dev/null @@ -1,28 +0,0 @@ - - - - - Socket.IO Chat Example - - - - - - - - - - diff --git a/servant-examples/socket-io-chat/resources/main.js b/servant-examples/socket-io-chat/resources/main.js deleted file mode 100644 index 08be0ad4..00000000 --- a/servant-examples/socket-io-chat/resources/main.js +++ /dev/null @@ -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 = $('
  • ').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 = $('') - .text(data.username) - .css('color', getUsernameColor(data.username)); - var $messageBodyDiv = $('') - .text(data.message); - - var typingClass = data.typing ? 'typing' : ''; - var $messageDiv = $('
  • ') - .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 $('
    ').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 — "; - 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); - }); -}); diff --git a/servant-examples/socket-io-chat/resources/style.css b/servant-examples/socket-io-chat/resources/style.css deleted file mode 100644 index 62cbe093..00000000 --- a/servant-examples/socket-io-chat/resources/style.css +++ /dev/null @@ -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%; -} diff --git a/servant-examples/socket-io-chat/socket-io-chat.hs b/servant-examples/socket-io-chat/socket-io-chat.hs deleted file mode 100644 index 4f5e649a..00000000 --- a/servant-examples/socket-io-chat/socket-io-chat.hs +++ /dev/null @@ -1,54 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeOperators #-} - - -import Data.Monoid ((<>)) -#if !MIN_VERSION_base(4,8,0) -import Control.Applicative ((<$>)) -#endif -import Network.EngineIO.Wai -import Network.Wai -import Network.Wai.Handler.Warp (run) -import Servant - - -import qualified Control.Concurrent.STM as STM -import qualified Network.SocketIO as SocketIO - - -import Chat (ServerState (..), eioServer) - - -type API = "socket.io" :> Raw - :<|> Raw - - -api :: Proxy API -api = Proxy - - -server :: WaiMonad () -> Server API -server sHandler = socketIOHandler - :<|> serveDirectory "socket-io-chat/resources" - - where - socketIOHandler req respond = toWaiApplication sHandler req respond - - -app :: WaiMonad () -> Application -app sHandler = serve api EmptyConfig $ server sHandler - -port :: Int -port = 3001 - - -main :: IO () -main = do - state <- ServerState <$> STM.newTVarIO 0 - sHandler <- SocketIO.initialize waiAPI (eioServer state) - putStrLn $ "Running on " <> show port - run port $ app sHandler - - diff --git a/servant-examples/tinc.yaml b/servant-examples/tinc.yaml deleted file mode 100644 index 10af8970..00000000 --- a/servant-examples/tinc.yaml +++ /dev/null @@ -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 diff --git a/servant-examples/wai-middleware/wai-middleware.hs b/servant-examples/wai-middleware/wai-middleware.hs deleted file mode 100644 index 7ad34c3f..00000000 --- a/servant-examples/wai-middleware/wai-middleware.hs +++ /dev/null @@ -1,51 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -import Data.Aeson -import Data.Text -import GHC.Generics -import Network.Wai -import Network.Wai.Handler.Warp -import Network.Wai.Middleware.RequestLogger -import Servant - -data Product = Product - { name :: Text - , brand :: Text - , current_price_eur :: Double - , available :: Bool - } deriving (Eq, Show, Generic) - -instance ToJSON Product - -products :: [Product] -products = [p1, p2] - - where p1 = Product "Haskell laptop sticker" - "GHC Industries" - 2.50 - True - - p2 = Product "Foldable USB drive" - "Well-Typed" - 13.99 - False - -type SimpleAPI = Get '[JSON] [Product] - -simpleAPI :: Proxy SimpleAPI -simpleAPI = Proxy - -server :: Server SimpleAPI -server = return products - --- logStdout :: Middleware --- i.e, logStdout :: Application -> Application --- serve :: Proxy api -> Config config -> Server api -> Application --- so applying a middleware is really as simple as --- applying a function to the result of 'serve' -app :: Application -app = logStdout (serve simpleAPI EmptyConfig server) - -main :: IO () -main = run 8080 app