add an example on how to derive client functions for Hackage
This commit is contained in:
parent
6651df574a
commit
29632c4ac2
4 changed files with 144 additions and 0 deletions
30
servant-examples/LICENSE
Normal file
30
servant-examples/LICENSE
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
Copyright (c) 2015, Alp Mestanogullari
|
||||||
|
|
||||||
|
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.
|
2
servant-examples/Setup.hs
Normal file
2
servant-examples/Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
import Distribution.Simple
|
||||||
|
main = defaultMain
|
83
servant-examples/hackage/hackage.hs
Normal file
83
servant-examples/hackage/hackage.hs
Normal file
|
@ -0,0 +1,83 @@
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Trans.Either
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.Monoid
|
||||||
|
import Data.Proxy
|
||||||
|
import Data.Text (Text)
|
||||||
|
import GHC.Generics
|
||||||
|
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
|
||||||
|
|
||||||
|
getUsers :: BaseUrl -> EitherT ServantError IO [UserSummary]
|
||||||
|
getUser :: Username -> BaseUrl -> EitherT ServantError IO UserDetailed
|
||||||
|
getPackages :: BaseUrl -> EitherT ServantError IO [Package]
|
||||||
|
getUsers :<|> getUser :<|> getPackages = client hackageAPI
|
||||||
|
|
||||||
|
run :: (BaseUrl -> r) -> r
|
||||||
|
run f = f (BaseUrl Http "hackage.haskell.org" 80)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = print =<< uselessNumbers
|
||||||
|
|
||||||
|
uselessNumbers :: IO (Either ServantError ())
|
||||||
|
uselessNumbers = runEitherT $ do
|
||||||
|
users <- run getUsers
|
||||||
|
liftIO . putStrLn $ show (length users) ++ " users"
|
||||||
|
|
||||||
|
user <- liftIO $ do
|
||||||
|
putStrLn "Enter a valid hackage username"
|
||||||
|
T.getLine
|
||||||
|
userDetailed <- run (getUser user)
|
||||||
|
liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
|
||||||
|
|
||||||
|
packages <- run getPackages
|
||||||
|
let monadPackages = filter (isMonadPackage . packageName) packages
|
||||||
|
liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
|
||||||
|
|
||||||
|
where isMonadPackage = T.isInfixOf "monad"
|
29
servant-examples/servant-examples.cabal
Normal file
29
servant-examples/servant-examples.cabal
Normal file
|
@ -0,0 +1,29 @@
|
||||||
|
name: servant-examples
|
||||||
|
version: 0.3
|
||||||
|
synopsis: Example programs for servant
|
||||||
|
description: Example programs for servant
|
||||||
|
homepage: http://haskell-servant.github.io/
|
||||||
|
license: BSD3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Alp Mestanogullari
|
||||||
|
maintainer: alpmestan@gmail.com
|
||||||
|
-- copyright:
|
||||||
|
category: Web
|
||||||
|
build-type: Simple
|
||||||
|
-- extra-source-files:
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
executable hackage
|
||||||
|
main-is: hackage.hs
|
||||||
|
-- other-modules:
|
||||||
|
-- other-extensions:
|
||||||
|
build-depends:
|
||||||
|
aeson >= 0.8
|
||||||
|
, base >=4.7
|
||||||
|
, either
|
||||||
|
, servant
|
||||||
|
, servant-client
|
||||||
|
, text
|
||||||
|
, transformers
|
||||||
|
hs-source-dirs: hackage
|
||||||
|
default-language: Haskell2010
|
Loading…
Reference in a new issue