mirror of
https://github.com/ilyakooo0/servant-reflex.git
synced 2024-09-11 07:15:29 +03:00
Bring in test project
This commit is contained in:
parent
e302b6aa96
commit
8f8b776523
6
.gitmodules
vendored
6
.gitmodules
vendored
@ -7,3 +7,9 @@
|
||||
[submodule "deps/servant"]
|
||||
path = deps/servant
|
||||
url = https://github.com/haskell-servant/servant.git
|
||||
[submodule "deps/servant-snap"]
|
||||
path = deps/servant-snap
|
||||
url = https://github.com/haskell-servant/servant-snap
|
||||
[submodule "deps/reflex-dom"]
|
||||
path = deps/reflex-dom
|
||||
url = https://github.com/ryantrinkle/reflex-dom
|
||||
|
1
deps/reflex-dom
vendored
Submodule
1
deps/reflex-dom
vendored
Submodule
@ -0,0 +1 @@
|
||||
Subproject commit b3f9b5f0b477d4bb09f6a4076c902aefbe9f4eb0
|
1
deps/servant-snap
vendored
Submodule
1
deps/servant-snap
vendored
Submodule
@ -0,0 +1 @@
|
||||
Subproject commit e22be66f448d76b9371dc47853a1c642f4745177
|
@ -1,77 +0,0 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import Data.Text
|
||||
import GHC.Generics
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp
|
||||
|
||||
import Servant
|
||||
import API
|
||||
|
||||
-- * Example
|
||||
|
||||
-- | A greet message data type
|
||||
newtype Greet = Greet { _msg :: Text }
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON Greet
|
||||
instance ToJSON Greet
|
||||
|
||||
-- API specification
|
||||
type TestApi =
|
||||
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
|
||||
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
|
||||
|
||||
-- POST /greet with a Greet as JSON in the request body,
|
||||
-- returns a Greet as JSON
|
||||
:<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
|
||||
|
||||
-- DELETE /greet/:greetid
|
||||
:<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] ()
|
||||
|
||||
testApi :: Proxy TestApi
|
||||
testApi = Proxy
|
||||
|
||||
|
||||
server1 :: Server API
|
||||
server1 = return $ Right ()
|
||||
|
||||
-- Server-side handlers.
|
||||
--
|
||||
-- There's one handler per endpoint, which, just like in the type
|
||||
-- that represents the API, are glued together using :<|>.
|
||||
--
|
||||
-- Each handler runs in the 'ExceptT ServantErr IO' monad.
|
||||
server :: Server TestApi
|
||||
server = helloH :<|> postGreetH :<|> deleteGreetH
|
||||
|
||||
where helloH name Nothing = helloH name (Just False)
|
||||
helloH name (Just False) = return . Greet $ "Hello, " <> name
|
||||
helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
||||
|
||||
postGreetH greet = return greet
|
||||
|
||||
deleteGreetH _ = return ()
|
||||
|
||||
-- Turn the server into a WAI app. 'serve' is provided by servant,
|
||||
-- more precisely by the Servant.Server module.
|
||||
test :: Application
|
||||
test = serve testApi EmptyConfig server
|
||||
|
||||
-- Run the server.
|
||||
--
|
||||
-- 'run' comes from Network.Wai.Handler.Warp
|
||||
runTestServer :: Port -> IO ()
|
||||
runTestServer port = run port test
|
||||
|
||||
-- Put this all to work!
|
||||
main :: IO ()
|
||||
main = runTestServer 8000
|
40
init-sandbox.sh
Executable file
40
init-sandbox.sh
Executable file
@ -0,0 +1,40 @@
|
||||
#! /bin/sh
|
||||
|
||||
cabal sandbox init
|
||||
|
||||
cabal sandbox add-source deps/snaplet-postgresql-simple
|
||||
|
||||
#! /bin/sh
|
||||
|
||||
cabal sandbox init
|
||||
|
||||
echo "Depend on snap-1.0 from github. Move to Hackage version when snap-1.0 is released"
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap/deps/io-streams
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap/deps/io-streams-haproxy
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap/deps/snap-core
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap/deps/snap-server
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap/deps/xmlhtml
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap/deps/heist
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap-loader-static
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap-loader-static
|
||||
cabal sandbox add-source deps/servant-snap/deps/snap
|
||||
cabal sandbox add-source deps/servant-snap/deps/hspec-snap
|
||||
|
||||
echo "Depend on particular servant branch with (Raw m a) changes"
|
||||
echo "TODO: Move to hackage version when servant-0.5 is released"
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant-docs
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant-client
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant-blaze
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant-js
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant-lucid
|
||||
cabal sandbox add-source deps/servant-snap/deps/servant/servant-mock
|
||||
|
||||
cabal sandbox add-source deps/servant-snap
|
||||
cabal sandbox add-source deps/reflex-dom
|
||||
cabal sandbox add-source deps/reflex-dom-contrib
|
||||
|
||||
cabal sandbox add-source .
|
||||
|
||||
cd test/front && cabal sandbox init --sandbox=../../.cabal-sandbox && cd ../..
|
||||
cd test/back && cabal sandbox init --sandbox=../../.cabal-sandbox && cd ../..
|
1
test/back/API.hs
Symbolic link
1
test/back/API.hs
Symbolic link
@ -0,0 +1 @@
|
||||
../common/API.hs
|
30
test/back/LICENSE
Normal file
30
test/back/LICENSE
Normal file
@ -0,0 +1,30 @@
|
||||
Copyright (c) 2016, Greg Hale
|
||||
|
||||
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 Greg Hale 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.
|
57
test/back/Main.hs
Normal file
57
test/back/Main.hs
Normal file
@ -0,0 +1,57 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Monoid
|
||||
import Data.Proxy
|
||||
import Data.Text
|
||||
import GHC.Generics
|
||||
import Snap.Http.Server
|
||||
import Snap.Core
|
||||
import Servant.Server.Internal.SnapShims
|
||||
|
||||
import Servant
|
||||
import Servant.Server
|
||||
import API
|
||||
|
||||
-- * Example
|
||||
|
||||
-- | A greet message data type
|
||||
newtype Greet = Greet { _msg :: Text }
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON Greet
|
||||
instance ToJSON Greet
|
||||
|
||||
testApi :: Proxy API
|
||||
testApi = Proxy
|
||||
|
||||
-- Server-side handlers.
|
||||
--
|
||||
-- There's one handler per endpoint, which, just like in the type
|
||||
-- that represents the API, are glued together using :<|>.
|
||||
--
|
||||
-- Each handler runs in the 'ExceptT ServantErr IO' monad.
|
||||
server :: Server API Snap
|
||||
server = return ()
|
||||
|
||||
where helloH name Nothing = helloH name (Just False)
|
||||
helloH name (Just False) = return . Greet $ "Hello, " <> name
|
||||
helloH name (Just True) = return . Greet . toUpper $ "Hello, " <> name
|
||||
|
||||
postGreetH greet = return greet
|
||||
|
||||
deleteGreetH _ = return ()
|
||||
|
||||
-- Turn the server into a WAI app. 'serve' is provided by servant,
|
||||
-- more precisely by the Servant.Server module.
|
||||
test :: Application Snap
|
||||
test = serve testApi server
|
||||
|
||||
-- Put this all to work!
|
||||
main :: IO ()
|
||||
main = quickHttpServe $ applicationToSnap (serve testApi server)
|
24
test/back/back.cabal
Normal file
24
test/back/back.cabal
Normal file
@ -0,0 +1,24 @@
|
||||
-- Initial back.cabal generated by cabal init. For further documentation,
|
||||
-- see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: back
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Greg Hale
|
||||
maintainer: imalsogreg@gmail.com
|
||||
-- copyright:
|
||||
-- category:
|
||||
build-type: Simple
|
||||
-- extra-source-files:
|
||||
cabal-version: >=1.10
|
||||
|
||||
executable back
|
||||
main-is: Main.hs
|
||||
-- other-modules:
|
||||
-- other-extensions:
|
||||
build-depends: aeson, base >=4.8 && <4.9, snap, snap-server, snap-core, servant, servant-snap, text
|
||||
-- hs-source-dirs:
|
||||
default-language: Haskell2010
|
8
test/common/API.hs
Normal file
8
test/common/API.hs
Normal file
@ -0,0 +1,8 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module API where
|
||||
|
||||
import Servant.API
|
||||
|
||||
type API = Get '[JSON] ()
|
1
test/front/API.hs
Symbolic link
1
test/front/API.hs
Symbolic link
@ -0,0 +1 @@
|
||||
../common/API.hs
|
30
test/front/LICENSE
Normal file
30
test/front/LICENSE
Normal file
@ -0,0 +1,30 @@
|
||||
Copyright (c) 2016, Greg Hale
|
||||
|
||||
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 Greg Hale 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.
|
28
test/front/Main.hs
Normal file
28
test/front/Main.hs
Normal file
@ -0,0 +1,28 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Servant.Reflex
|
||||
import API
|
||||
import Data.Proxy
|
||||
import Reflex.Dom
|
||||
import Reflex.Dom.Contrib.Xhr
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
url :: BaseUrl
|
||||
url = BaseUrl Http "localhost" 8000 ""
|
||||
|
||||
main :: IO ()
|
||||
main = mainWidget run
|
||||
|
||||
run :: forall t m. MonadWidget t m => m ()
|
||||
run = do
|
||||
let (getUnit :: Event t () -> m (Event t ((),()))) = client api url
|
||||
b :: Event t () <- button "Get unit"
|
||||
res :: Event t ((),()) <- getUnit b
|
||||
c <- foldDyn (\_ (n :: Int) -> succ n) 0 res
|
||||
display c
|
||||
|
10
test/front/default.nix
Normal file
10
test/front/default.nix
Normal file
@ -0,0 +1,10 @@
|
||||
{ mkDerivation, base, servant, servant-reflex, stdenv }:
|
||||
mkDerivation {
|
||||
pname = "front";
|
||||
version = "0.1.0.0";
|
||||
src = ./.;
|
||||
isLibrary = false;
|
||||
isExecutable = true;
|
||||
executableHaskellDepends = [ base servant servant-reflex ];
|
||||
license = stdenv.lib.licenses.bsd3;
|
||||
}
|
24
test/front/front.cabal
Normal file
24
test/front/front.cabal
Normal file
@ -0,0 +1,24 @@
|
||||
-- Initial front.cabal generated by cabal init. For further documentation,
|
||||
-- see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: front
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Greg Hale
|
||||
maintainer: imalsogreg@gmail.com
|
||||
-- copyright:
|
||||
-- category:
|
||||
build-type: Simple
|
||||
-- extra-source-files:
|
||||
cabal-version: >=1.10
|
||||
|
||||
executable front
|
||||
main-is: Main.hs
|
||||
other-modules: API
|
||||
other-extensions: ScopedTypeVariables, RankNTypes
|
||||
build-depends: base >=4.8 && <4.9, servant, servant-reflex
|
||||
-- hs-source-dirs:
|
||||
default-language: Haskell2010
|
Loading…
Reference in New Issue
Block a user