<commit_before>{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell #-}

module Redmine where

import Data.ByteString as BS (ByteString(..), concat)
import Data.ByteString.Char8 as Char8 (split, pack)
import Data.ByteString.Lazy (fromChunks)
import System.IO.Streams (write)
import Network.Http.Client
import Data.Maybe
import Data.Text as T (Text(..), splitOn, pack, span, take, drop)
import Data.Text.Read (decimal)
import Data.Text.Encoding as TE
import Text.Printf
import Data.Time.Clock
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.List (find)
import Data.Aeson.TH (deriveJSON)
import Data.Maybe

import Text.XML (Node(..))
import Text.XML.Cursor
import Text.XML.Selector.TH
import Text.XML.Scraping
import Text.HTML.DOM (parseLBS)

import qualified Util as Util
import Event
import EventProvider

data RedmineConfig = RedmineConfig
	{
		redmineUrl :: ByteString,
		redmineUsername :: ByteString,
		redmineUserDisplay :: T.Text,
		redminePassword :: ByteString
	} deriving Show
deriveJSON id ''RedmineConfig

getRedmineProvider :: EventProvider RedmineConfig
getRedmineProvider = EventProvider
	{
		getModuleName = "Redmine",
		getEvents = getRedmineEvents
	}

getRedmineEvents :: RedmineConfig -> Day -> IO [Event]
getRedmineEvents config day = do
	maybeCookie <- login config
	let cookieRows = split '\n' $ fromJust maybeCookie
	let cookieValues = fmap (head . (split ';')) cookieRows
	let activityUrl = prepareActivityUrl day
	response <- Util.http activityUrl "" concatHandler $ do
		http GET "/activity?show_wiki_edits=1"
		setHeader "Cookie" (cookieValues !! 1)
	timezone <- getCurrentTimeZone
	today <- date
	return $ mergeSuccessiveEvents $ getIssues config response day today timezone

mergeSuccessiveEvents :: [Event] -> [Event]
mergeSuccessiveEvents (x:y:xs) = if firstPart x == firstPart y
		then x : mergeSuccessiveEvents xs
		else x : (mergeSuccessiveEvents $ y :xs)
	where firstPart = head . (T.splitOn "(") . desc
mergeSuccessiveEvents whatever@_ = whatever

prepareActivityUrl :: Day -> ByteString
prepareActivityUrl day = BS.concat ["http://redmine/activity?from=", dayBeforeStr]
	where
		dayBefore = addDays (-1) day
		(y, m, d) = toGregorian dayBefore
		dayBeforeStr = Char8.pack $ printf "%d-%02d-%02d" y m d

-- returns the cookie
login :: RedmineConfig -> IO (Maybe ByteString)
login config = do
	postForm
		(BS.concat [redmineUrl config, "login"])
		[("username", redmineUsername config), ("password", redminePassword config)]
		(\r _ -> return $ getHeader r "Set-Cookie")

getIssues :: RedmineConfig -> ByteString -> Day -> Day -> TimeZone -> [Event]
getIssues config html day today timezone = case maybeDayNode of
		Nothing -> [] -- no events at all that day.
		Just dayNode -> getIssuesForDayNode config day timezone dayNode
	where
		doc = fromDocument $ parseLBS $ fromChunks [html]
		dayNodes = queryT [jq| div#content div#activity h3 |] doc
		maybeDayNode = find (isDayTitle day today) dayNodes
<commit_msg>new implementation for merge successive events<commit_after>{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell #-}

module Redmine where

import Data.ByteString as BS (ByteString(..), concat)
import Data.ByteString.Char8 as Char8 (split, pack)
import Data.ByteString.Lazy (fromChunks)
import System.IO.Streams (write)
import Network.Http.Client
import Data.Maybe
import Data.Text as T (Text(..), splitOn, pack, span, take, drop)
import Data.Text.Read (decimal)
import Data.Text.Encoding as TE
import Text.Printf
import Data.Time.Clock
import Data.Time.Calendar
import Data.Time.LocalTime
import Data.List (find)
import Data.Aeson.TH (deriveJSON)
import Data.Maybe

import Text.XML (Node(..))
import Text.XML.Cursor
import Text.XML.Selector.TH
import Text.XML.Scraping
import Text.HTML.DOM (parseLBS)

import qualified Util as Util
import Event
import EventProvider

data RedmineConfig = RedmineConfig
	{
		redmineUrl :: ByteString,
		redmineUsername :: ByteString,
		redmineUserDisplay :: T.Text,
		redminePassword :: ByteString
	} deriving Show
deriveJSON id ''RedmineConfig

getRedmineProvider :: EventProvider RedmineConfig
getRedmineProvider = EventProvider
	{
		getModuleName = "Redmine",
		getEvents = getRedmineEvents
	}

getRedmineEvents :: RedmineConfig -> Day -> IO [Event]
getRedmineEvents config day = do
	maybeCookie <- login config
	let cookieRows = split '\n' $ fromJust maybeCookie
	let cookieValues = fmap (head . (split ';')) cookieRows
	let activityUrl = prepareActivityUrl day
	response <- Util.http activityUrl "" concatHandler $ do
		http GET "/activity?show_wiki_edits=1"
		setHeader "Cookie" (cookieValues !! 1)
	timezone <- getCurrentTimeZone
	today <- date
	return $ mergeSuccessiveEvents $ getIssues config response day today timezone

mergeSuccessiveEvents :: [Event] -> [Event]
mergeSuccessiveEvents (x:xs) = x : (mergeSuccessiveEvents $ dropWhile firstPartMatches xs)
	where
		firstPartMatches y = firstPart y == firstPartX
		firstPartX = firstPart x
		firstPart = head . (T.splitOn "(") . desc
mergeSuccessiveEvents [] = []

-- mergeSuccessiveEvents :: [Event] -> [Event]
-- mergeSuccessiveEvents (x:y:xs) = if firstPart x == firstPart y
-- 		then x : mergeSuccessiveEvents xs
-- 		else x : (mergeSuccessiveEvents $ y :xs)
-- 	where firstPart = head . (T.splitOn "(") . desc
-- mergeSuccessiveEvents whatever@_ = whatever

prepareActivityUrl :: Day -> ByteString
prepareActivityUrl day = BS.concat ["http://redmine/activity?from=", dayBeforeStr]
	where
		dayBefore = addDays (-1) day
		(y, m, d) = toGregorian dayBefore
		dayBeforeStr = Char8.pack $ printf "%d-%02d-%02d" y m d

-- returns the cookie
login :: RedmineConfig -> IO (Maybe ByteString)
login config = do
	postForm
		(BS.concat [redmineUrl config, "login"])
		[("username", redmineUsername config), ("password", redminePassword config)]
		(\r _ -> return $ getHeader r "Set-Cookie")

getIssues :: RedmineConfig -> ByteString -> Day -> Day -> TimeZone -> [Event]
getIssues config html day today timezone = case maybeDayNode of
		Nothing -> [] -- no events at all that day.
		Just dayNode -> getIssuesForDayNode config day timezone dayNode
	where
		doc = fromDocument $ parseLBS $ fromChunks [html]
		dayNodes = queryT [jq| div#content div#activity h3 |] doc
		maybeDayNode = find (isDayTitle day today) dayNodes

{'fraction_non_alphanumeric': 0.10534691279439848, 'fraction_numerical': 0.003500954805856143, 'mean_word_length': 4.646900269541779, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 30, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '335940', 'n_tokens_mistral': 1997, 'n_tokens_neox': 1923, 'n_words': 607}