servant/servant-examples/hackage/hackage.hs

91 lines
2.6 KiB
Haskell
Raw Normal View History

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
2015-09-23 18:26:05 +02:00
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
2015-09-12 14:11:24 +02:00
import Control.Monad.Trans.Except
import Data.Aeson
import Data.Monoid
import Data.Proxy
import Data.Text (Text)
import GHC.Generics
2015-09-28 18:07:12 +02:00
import Network.HTTP.Client (Manager, defaultManagerSettings,
newManager)
import System.IO.Unsafe (unsafePerformIO)
import Servant.API
import Servant.Client
import qualified Data.Text as T
import qualified Data.Text.IO as T
type HackageAPI =
2015-04-23 17:10:43 +02:00
"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
2015-09-28 18:07:12 +02:00
{-# NOINLINE manager #-}
manager :: Manager
manager = unsafePerformIO $ newManager defaultManagerSettings
2015-09-12 14:11:24 +02:00
getUsers :: ExceptT ServantError IO [UserSummary]
getUser :: Username -> ExceptT ServantError IO UserDetailed
getPackages :: ExceptT ServantError IO [Package]
2015-09-28 18:07:12 +02:00
getUsers :<|> getUser :<|> getPackages =
client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
main :: IO ()
main = print =<< uselessNumbers
uselessNumbers :: IO (Either ServantError ())
2015-09-12 14:11:24 +02:00
uselessNumbers = runExceptT $ do
users <- getUsers
liftIO . putStrLn $ show (length users) ++ " users"
user <- liftIO $ do
putStrLn "Enter a valid hackage username"
T.getLine
2015-09-28 18:07:12 +02:00
userDetailed <- getUser user
liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
packages <- getPackages
let monadPackages = filter (isMonadPackage . packageName) packages
liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
where isMonadPackage = T.isInfixOf "monad"