git.iko.soy/servant
on feef8ca help sign in
servant/servant-examples/hackage/hackage.hs
90 lines 2.7 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE TypeOperators #-}
5{-# OPTIONS_GHC -fno-warn-unused-imports #-}
6import Control.Applicative
7import Control.Monad
8import Control.Monad.IO.Class
9import Control.Monad.Trans.Except
10import Data.Aeson
11import Data.Monoid
12import Data.Proxy
13import Data.Text (Text)
14import GHC.Generics
15import Network.HTTP.Client (Manager, defaultManagerSettings,
16 newManager)
17import System.IO.Unsafe (unsafePerformIO)
18import Servant.API
19import Servant.Client
21import qualified Data.Text as T
22import qualified Data.Text.IO as T
24type HackageAPI =
25 "users" :> Get '[JSON] [UserSummary]
26 :<|> "user" :> Capture "username" Username :> Get '[JSON] UserDetailed
27 :<|> "packages" :> Get '[JSON] [Package]
29type Username = Text
31data UserSummary = UserSummary
32 { summaryUsername :: Username
33 , summaryUserid :: Int
34 } deriving (Eq, Show)
36instance FromJSON UserSummary where
37 parseJSON (Object o) =
38 UserSummary <$> o .: "username"
39 <*> o .: "userid"
41 parseJSON _ = mzero
43type Group = Text
45data UserDetailed = UserDetailed
46 { username :: Username
47 , userid :: Int
48 , groups :: [Group]
49 } deriving (Eq, Show, Generic)
51instance FromJSON UserDetailed
53newtype Package = Package { packageName :: Text }
54 deriving (Eq, Show, Generic)
56instance FromJSON Package
58hackageAPI :: Proxy HackageAPI
59hackageAPI = Proxy
62{-# NOINLINE manager #-}
63manager :: Manager
64manager = unsafePerformIO $ newManager defaultManagerSettings
66getUsers :: ExceptT ServantError IO [UserSummary]
67getUser :: Username -> ExceptT ServantError IO UserDetailed
68getPackages :: ExceptT ServantError IO [Package]
69getUsers :<|> getUser :<|> getPackages =
70 client hackageAPI (BaseUrl Http "hackage.haskell.org" 80 "") manager
72main :: IO ()
73main = print =<< uselessNumbers
75uselessNumbers :: IO (Either ServantError ())
76uselessNumbers = runExceptT $ do
77 users <- getUsers
78 liftIO . putStrLn $ show (length users) ++ " users"
80 user <- liftIO $ do
81 putStrLn "Enter a valid hackage username"
82 T.getLine
83 userDetailed <- getUser user
84 liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
86 packages <- getPackages
87 let monadPackages = filter (isMonadPackage . packageName) packages
88 liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
90 where isMonadPackage = T.isInfixOf "monad"