<commit_before>{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell    #-}

module Feed.Annotated where

import           Control.Applicative
import           Control.Lens
import           Data.Hashable
import           Data.Map            (Map)
import qualified Data.Map            as M
import           Data.IntMap         (IntMap)
import qualified Data.IntMap         as IM
import           Data.Maybe
import           Data.Monoid
import           Data.Serialize
import           Data.Text           (Text)
import qualified Data.Text           as T
import           Data.Time
import           GHC.Generics        (Generic)
import           System.Locale
import           Test.QuickCheck     hiding (Failure, Success)

import           Feed.Feed
import           Fetching.History

------------------------------------------------------------------------

data AnnItem = AnnItem
  { _item   :: Item
  , _isRead :: Bool
  }
  deriving (Eq, Generic)

makeLenses ''AnnItem

defAnnItem :: Item -> AnnItem
defAnnItem i = AnnItem i False

instance Show AnnItem where
  show i = i^.item.itemTitle.to (maybe "(no item title)" T.unpack)

data AnnFeed = AnnFeed
  { _feed    :: Feed' [AnnItem]
  , _alias   :: Maybe Text
  , _history :: [History]
  }
  deriving (Eq, Generic)

makeLenses ''AnnFeed

newEmptyAnnFeed :: AnnFeed
newEmptyAnnFeed = AnnFeed
  { _feed    = newEmptyFeed AtomKind & feedItems.traverse %~ defAnnItem
  , _alias   = Nothing
  , _history = []
  }

defAnnFeed :: Feed -> AnnFeed
defAnnFeed f = newEmptyAnnFeed
  & feed .~ (f & feedItems.traverse %~ defAnnItem)

instance Show AnnFeed where
  show f = f^.feed.feedTitle.to (maybe "(no title)" T.unpack)

-- (Multiples of same feed will cause problems.)
mergeFeeds :: [AnnFeed] -> [AnnFeed] -> [AnnFeed]
mergeFeeds old new = flip map new $ \n ->
  case M.lookup (n^.feed.feedHome) m of
    Nothing -> n
    Just o  -> merge o n
  where
  m :: Map URL AnnFeed
  m = M.fromList $ map (\o -> (o^.feed.feedHome, o)) old

merge :: AnnFeed -> AnnFeed -> AnnFeed
merge old new
  | new^.history^?_head._Failure & isJust
  = old & history %~ \h -> prune (new^.history ++ h)

  | otherwise
  = new & feed.feedItems .~ mergeItems (old^.feed.feedItems)
                                       (new^.feed.feedItems)
        & alias          .~ old^.alias
        & history        %~ \h -> prune (h ++ old^.history)
  where
  prune = take 10

mergeItems :: [AnnItem] -> [AnnItem] -> [AnnItem]
mergeItems old new = flip map new $ \n ->
  case IM.lookup (hashItem n) m of
    Nothing -> n
    Just o  -> n & isRead .~ o^.isRead
  where
  hashItem :: AnnItem -> Int
  hashItem i = hash (i^.item.itemTitle) `hashWithSalt`
               hash (i^.item.itemDescription)

  m :: IntMap AnnItem
  m = IM.fromList $ map (\o -> (hashItem o, o)) old


-- | The function for merging items is idempotent.<commit_msg>Use IntMap instead of Map.<commit_after>{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell    #-}

module Feed.Annotated where

import           Control.Applicative
import           Control.Lens
import           Data.Hashable
import           Data.IntMap         (IntMap)
import qualified Data.IntMap         as M
import           Data.Maybe
import           Data.Monoid
import           Data.Serialize
import           Data.Text           (Text)
import qualified Data.Text           as T
import           Data.Time
import           GHC.Generics        (Generic)
import           System.Locale
import           Test.QuickCheck     hiding (Failure, Success)

import           Feed.Feed
import           Fetching.History

------------------------------------------------------------------------

data AnnItem = AnnItem
  { _item   :: Item
  , _isRead :: Bool
  }
  deriving (Eq, Generic)

makeLenses ''AnnItem

defAnnItem :: Item -> AnnItem
defAnnItem i = AnnItem i False

instance Show AnnItem where
  show i = i^.item.itemTitle.to (maybe "(no item title)" T.unpack)

data AnnFeed = AnnFeed
  { _feed    :: Feed' [AnnItem]
  , _alias   :: Maybe Text
  , _history :: [History]
  }
  deriving (Eq, Generic)

makeLenses ''AnnFeed

newEmptyAnnFeed :: AnnFeed
newEmptyAnnFeed = AnnFeed
  { _feed    = newEmptyFeed AtomKind & feedItems.traverse %~ defAnnItem
  , _alias   = Nothing
  , _history = []
  }

defAnnFeed :: Feed -> AnnFeed
defAnnFeed f = newEmptyAnnFeed
  & feed .~ (f & feedItems.traverse %~ defAnnItem)

instance Show AnnFeed where
  show f = f^.feed.feedTitle.to (maybe "(no title)" T.unpack)

-- (Multiples of same feed will cause problems.)
mergeFeeds :: [AnnFeed] -> [AnnFeed] -> [AnnFeed]
mergeFeeds old new = flip map new $ \n ->
  case M.lookup (hash (n^.feed.feedHome)) m of
    Nothing -> n
    Just o  -> merge o n
  where
  m :: IntMap AnnFeed
  m = M.fromList $ map (\o -> (hash (o^.feed.feedHome), o)) old

merge :: AnnFeed -> AnnFeed -> AnnFeed
merge old new
  | new^.history^?_head._Failure & isJust
  = old & history %~ \h -> prune (new^.history ++ h)

  | otherwise
  = new & feed.feedItems .~ mergeItems (old^.feed.feedItems)
                                       (new^.feed.feedItems)
        & alias          .~ old^.alias
        & history        %~ \h -> prune (h ++ old^.history)
  where
  prune = take 10

mergeItems :: [AnnItem] -> [AnnItem] -> [AnnItem]
mergeItems old new = flip map new $ \n ->
  case M.lookup (hashItem n) m of
    Nothing -> n
    Just o  -> n & isRead .~ o^.isRead
  where
  hashItem :: AnnItem -> Int
  hashItem i = hash (i^.item.itemTitle) `hashWithSalt`
               hash (i^.item.itemDescription)

  m :: IntMap AnnItem
  m = M.fromList $ map (\o -> (hashItem o, o)) old


-- | The function for merging items is idempotent.
{'fraction_non_alphanumeric': 0.13564288176490866, 'fraction_numerical': 0.0006894174422612892, 'mean_word_length': 2.062269129287599, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 41, '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': '7352766', 'n_tokens_mistral': 1852, 'n_tokens_neox': 1799, 'n_words': 540}