Bring in test project

This commit is contained in:
Greg Hale 2016-02-06 22:44:38 -05:00
parent e302b6aa96
commit 8f8b776523
15 changed files with 261 additions and 77 deletions

6
.gitmodules vendored
View File

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

@ -0,0 +1 @@
Subproject commit b3f9b5f0b477d4bb09f6a4076c902aefbe9f4eb0

1
deps/servant-snap vendored Submodule

@ -0,0 +1 @@
Subproject commit e22be66f448d76b9371dc47853a1c642f4745177

View File

@ -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
View 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
View File

@ -0,0 +1 @@
../common/API.hs

30
test/back/LICENSE Normal file
View 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
View 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
View 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
View 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
View File

@ -0,0 +1 @@
../common/API.hs

30
test/front/LICENSE Normal file
View 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
View 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
View 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
View 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