From 29632c4ac23ad0e630ab2321553695247d883973 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Thu, 23 Apr 2015 13:07:52 +0200 Subject: [PATCH] add an example on how to derive client functions for Hackage --- servant-examples/LICENSE | 30 +++++++++ servant-examples/Setup.hs | 2 + servant-examples/hackage/hackage.hs | 83 +++++++++++++++++++++++++ servant-examples/servant-examples.cabal | 29 +++++++++ 4 files changed, 144 insertions(+) create mode 100644 servant-examples/LICENSE create mode 100644 servant-examples/Setup.hs create mode 100644 servant-examples/hackage/hackage.hs create mode 100644 servant-examples/servant-examples.cabal diff --git a/servant-examples/LICENSE b/servant-examples/LICENSE new file mode 100644 index 00000000..f2e47b91 --- /dev/null +++ b/servant-examples/LICENSE @@ -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. diff --git a/servant-examples/Setup.hs b/servant-examples/Setup.hs new file mode 100644 index 00000000..9a994af6 --- /dev/null +++ b/servant-examples/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/servant-examples/hackage/hackage.hs b/servant-examples/hackage/hackage.hs new file mode 100644 index 00000000..4f49ead3 --- /dev/null +++ b/servant-examples/hackage/hackage.hs @@ -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" diff --git a/servant-examples/servant-examples.cabal b/servant-examples/servant-examples.cabal new file mode 100644 index 00000000..3c63b278 --- /dev/null +++ b/servant-examples/servant-examples.cabal @@ -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