module GitHub (getVersionTags) where
import Control.Monad.Error
import Data.Aeson as Json
import qualified Data.Maybe as Maybe
import Data.Monoid ((<>))
import qualified Data.Vector as Vector
import Network.HTTP.Client
import qualified Elm.Package.Name as Name
import qualified Elm.Package.Version as Version
import qualified Utils.Http as Http
newtype Tags = Tags [String]
getVersionTags
:: (MonadIO m, MonadError String m)
=> Name.Name -> m [Version.Version]
getVersionTags (Name.Name user project) =
do response <-
Http.send url $ \request manager ->
httpLbs (request {requestHeaders = headers}) manager
case Json.eitherDecode (responseBody response) of
Left err -> throwError err
Right (Tags tags) -> return (Maybe.mapMaybe Version.fromString tags)
where
url = "https://api.github.com/repos/" ++ user ++ "/" ++ project ++ "/tags"
headers =
[("User-Agent", "elm-package")]
<> [("Accept", "application/json")]
instance FromJSON Tags where
parseJSON (Array arr) =
Tags `fmap` mapM toTag (Vector.toList arr)
where
toTag (Object obj) = obj .: "name"
toTag _ = fail "expecting an object"
parseJSON _ = fail "expecting an array"