unsafegetmeamanager

This commit is contained in:
Julian K. Arni 2015-09-28 18:07:12 +02:00
parent f14d227b11
commit 7049383e77
3 changed files with 21 additions and 3 deletions

View file

@ -12,6 +12,9 @@ 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
@ -55,10 +58,16 @@ 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 ""
getUsers :<|> getUser :<|> getPackages =
client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
main :: IO ()
main = print =<< uselessNumbers
@ -71,7 +80,7 @@ uselessNumbers = runExceptT $ do
user <- liftIO $ do
putStrLn "Enter a valid hackage username"
T.getLine
userDetailed <- (getUser user)
userDetailed <- getUser user
liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
packages <- getPackages

View file

@ -53,6 +53,7 @@ executable t8-main
build-depends:
aeson
, base >= 4.7 && < 5
, http-client > 0.4 && < 0.5
, servant == 0.5.*
, servant-client == 0.5.*
, servant-server == 0.5.*
@ -65,6 +66,7 @@ executable hackage
build-depends:
aeson >= 0.8
, base >=4.7 && < 5
, http-client > 0.4 && < 0.5
, servant == 0.5.*
, servant-client == 0.5.*
, text

View file

@ -4,8 +4,11 @@
module T8 where
import Control.Monad.Trans.Except
import Network.HTTP.Client (Manager, defaultManagerSettings,
newManager)
import Servant
import Servant.Client
import System.IO.Unsafe (unsafePerformIO)
import T3
@ -19,11 +22,15 @@ hello :: Maybe String -- ^ an optional value for "name"
marketing :: ClientInfo -- ^ value for the request body
-> ExceptT ServantError IO Email
position :<|> hello :<|> marketing = client api baseUrl
position :<|> hello :<|> marketing = client api baseUrl manager
baseUrl :: BaseUrl
baseUrl = BaseUrl Http "localhost" 8081 ""
{-# NOINLINE manager #-}
manager :: Manager
manager = unsafePerformIO $ newManager defaultManagerSettings
queries :: ExceptT ServantError IO (Position, HelloMessage, Email)
queries = do
pos <- position 10 10