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/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/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 @@ - - -
- -