git.iko.soy/typeable/servant
on 3bcbe80 help sign in
typeable/servant/servant-examples/hackage/hackage.hs
80 lines 2.2 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE OverloadedStrings #-}
5import Control.Applicative
6import Control.Monad
7import Control.Monad.IO.Class
8import Control.Monad.Trans.Either
9import Data.Aeson
10import Data.Monoid
11import Data.Proxy
12import Data.Text (Text)
13import GHC.Generics
14import Servant.API
15import Servant.Client
17import qualified Data.Text as T
18import qualified Data.Text.IO as T
20type HackageAPI =
21 "users" :> Get '[JSON] [UserSummary]
22 :<|> "user" :> Capture "username" Username :> Get '[JSON] UserDetailed
23 :<|> "packages" :> Get '[JSON] [Package]
25type Username = Text
27data UserSummary = UserSummary
28 { summaryUsername :: Username
29 , summaryUserid :: Int
30 } deriving (Eq, Show)
32instance FromJSON UserSummary where
33 parseJSON (Object o) =
34 UserSummary <$> o .: "username"
35 <*> o .: "userid"
37 parseJSON _ = mzero
39type Group = Text
41data UserDetailed = UserDetailed
42 { username :: Username
43 , userid :: Int
44 , groups :: [Group]
45 } deriving (Eq, Show, Generic)
47instance FromJSON UserDetailed
49newtype Package = Package { packageName :: Text }
50 deriving (Eq, Show, Generic)
52instance FromJSON Package
54hackageAPI :: Proxy HackageAPI
55hackageAPI = Proxy
57getUsers :: EitherT ServantError IO [UserSummary]
58getUser :: Username -> EitherT ServantError IO UserDetailed
59getPackages :: EitherT ServantError IO [Package]
60getUsers :<|> getUser :<|> getPackages = client hackageAPI $ BaseUrl Http "hackage.haskell.org" 80
62main :: IO ()
63main = print =<< uselessNumbers
65uselessNumbers :: IO (Either ServantError ())
66uselessNumbers = runEitherT $ do
67 users <- getUsers
68 liftIO . putStrLn $ show (length users) ++ " users"
70 user <- liftIO $ do
71 putStrLn "Enter a valid hackage username"
72 T.getLine
73 userDetailed <- (getUser user)
74 liftIO . T.putStrLn $ user <> " maintains " <> T.pack (show (length $ groups userDetailed)) <> " packages"
76 packages <- getPackages
77 let monadPackages = filter (isMonadPackage . packageName) packages
78 liftIO . putStrLn $ show (length monadPackages) ++ " monad packages"
80 where isMonadPackage = T.isInfixOf "monad"