<commit_before>module GitHub ( Client
              , newClient
              , fetchPath
              , User(..)
              , Repository(..)
              ) where

import ClassyPrelude
import Control.Monad.Trans.Resource
import Data.Aeson
import Data.Conduit
import Data.Default
import Network.HTTP.Conduit
import Network.HTTP.Types

data Client = Client
    { getToken :: Text
    , getManager :: Manager
    }

data User = User
    { userId :: Integer
    , userLogin :: Text
    } deriving (Eq, Show)

instance FromJSON User where
    parseJSON (Object v) = User <$>
                            v .: "id" <*>
                            v .: "login"
    parseJSON _ = mzero

data Repository = Repository
    { repoId :: Integer
    , repoOwner :: User
    , repoName :: Text
    , repoDescription :: Text
    , repoApiUrl :: String
    , repoHtmlUrl :: String
    } deriving (Eq, Show)

instance FromJSON Repository where
    parseJSON (Object v) = Repository <$>
                            v .: "id" <*>
                            v .: "owner" <*>
                            v .: "name" <*>
                            v .:? "description" .!= "" <*>
                            v .: "url" <*>
                            v .: "html_url"
    parseJSON _ = mzero

-- Creates a GitHub client with the given OAuth token.
newClient :: MonadIO m => Text -> m Client
newClient token = do
    manager <- liftIO $ newManager conduitManagerSettings
    return $ Client { getToken = token, getManager = manager }

-- Executes a GET request to the given relative path.
fetchPath :: MonadResource m => Client -> Text -> m (Response (ResumableSource m ByteString))
fetchPath client path =
    let req = def
                { method = methodGet
                , secure = True
                , host = "api.github.com"
                , path = encodeUtf8 path
                , queryString = "access_token=" ++ encodeUtf8 (getToken client)
                , requestHeaders = [ ("User-Agent", "ScrumBut") ]
                }
    in http req $ getManager client
<commit_msg>Add fetchJSON convenience function<commit_after>module GitHub ( Client
              , newClient
              , fetchPath
              , fetchJSON
              , User(..)
              , Repository(..)
              ) where

import ClassyPrelude
import Control.Monad.Trans.Resource
import Data.Aeson
import Data.Conduit
import Data.Conduit.Attoparsec
import Data.Default
import Network.HTTP.Conduit
import Network.HTTP.Types

data Client = Client
    { getToken :: Text
    , getManager :: Manager
    }

data User = User
    { userId :: Integer
    , userLogin :: Text
    } deriving (Eq, Show)

instance FromJSON User where
    parseJSON (Object v) = User <$>
                            v .: "id" <*>
                            v .: "login"
    parseJSON _ = mzero

data Repository = Repository
    { repoId :: Integer
    , repoOwner :: User
    , repoName :: Text
    , repoDescription :: Text
    , repoApiUrl :: String
    , repoHtmlUrl :: String
    } deriving (Eq, Show)

instance FromJSON Repository where
    parseJSON (Object v) = Repository <$>
                            v .: "id" <*>
                            v .: "owner" <*>
                            v .: "name" <*>
                            v .:? "description" .!= "" <*>
                            v .: "url" <*>
                            v .: "html_url"
    parseJSON _ = mzero

-- Creates a GitHub client with the given OAuth token.
newClient :: MonadIO m => Text -> m Client
newClient token = do
    manager <- liftIO $ newManager conduitManagerSettings
    return $ Client { getToken = token, getManager = manager }

-- Executes a GET request to the given relative path.
fetchPath :: MonadResource m => Client -> Text -> m (Response (ResumableSource m ByteString))
fetchPath client path =
    let req = def
                { method = methodGet
                , secure = True
                , host = "api.github.com"
                , path = encodeUtf8 path
                , queryString = "access_token=" ++ encodeUtf8 (getToken client)
                , requestHeaders = [ ("User-Agent", "ScrumBut") ]
                }
    in http req $ getManager client

-- Executes a GET request, and automatically deserializes the resulting JSON.
fetchJSON :: (MonadResource m, FromJSON a) => Client -> Text -> m a
fetchJSON client path = do
    response <- fetchPath client path
    value <- responseBody response $$+- sinkParser json

    case fromJSON value of
        Success a -> return a
        Error str -> fail str

{'fraction_non_alphanumeric': 0.09864391951006124, 'fraction_numerical': 0.0008748906386701663, 'mean_word_length': 1.6789689513766843, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 34, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2153939', 'n_tokens_mistral': 1244, 'n_tokens_neox': 1214, 'n_words': 386}