84 lines
2.2 KiB
Haskell
84 lines
2.2 KiB
Haskell
|
{-# 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"
|