{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
module Database
  (
    -- * Internal State
    FeedMonadState
  , emptyFeedMonadState
  , FeedId(..)
  , EntryId(..)
    -- * Update functions
  , SaveEntry(..)
  , SaveEntries(..)
    -- * Query functions
  , GetEntries(..)
  , GetEntry(..)
  , CountEntries(..)
  , UnseenEntries(..)
  )
where

import Data.Entry
import Data.Map.Strict (Map)
import Data.SafeCopy
import GHC.Generics (Generic)
import Data.Acid
import Control.Lens
import Control.Applicative ((<|>))
import Control.Monad.Reader (asks)
import Data.URL (URL)
import qualified Data.Map.Strict as M
import Data.Set (Set)
import qualified Data.Set as S

newtype FeedId = FeedId URL
  deriving (Show, Eq, Ord, Generic)

instance SafeCopy FeedId

newtype EntryId = EntryId URL
  deriving (Show, Eq, Ord, Generic)

instance SafeCopy EntryId

newtype FeedMonadState = FeedMonadState
  { _feeds :: Map FeedId (Map EntryId Entry) }
  deriving Show

emptyFeedMonadState :: FeedMonadState
emptyFeedMonadState = FeedMonadState mempty

feeds :: Lens' FeedMonadState (Map FeedId (Map EntryId Entry))
feeds = lens _feeds (\ fms f -> fms{_feeds=f})


-- | Save the entry to the database
saveEntry :: FeedId -> EntryId -> Entry -> Update FeedMonadState ()
saveEntry fid eid en = modifying (feeds . at fid . non mempty . at eid) (<|> Just en)

-- | Save a batch of entries to the database
--
-- Saves the new entries, preferring the old entries over the new entries
saveEntries :: FeedId -> [Entry] -> Update FeedMonadState ()
saveEntries fid entries = modifying (feeds . at fid) (\old -> Just (toEntryMap entries) <> old)
  where
    toEntryMap = foldMap (\e -> M.singleton (EntryId (entryURL e)) e)

getEntries :: FeedId -> Query FeedMonadState [Entry]
getEntries fid = asks (toListOf (feeds . ix fid . traversed))

-- | Count the number of entries in a feed
countEntries :: FeedId -> Query FeedMonadState Int
countEntries fid = asks (lengthOf (feeds . ix fid . traversed))

getEntry :: FeedId -> EntryId -> Query FeedMonadState (Maybe Entry)
getEntry fid eid = asks (preview (feeds . ix fid . ix eid))

-- | Filter the unseen entries
--
unseenEntries :: FeedId -> Set EntryId -> Query FeedMonadState (Set EntryId)
-- This seems to be an unfortunate effect of acid-state :/. If I try
-- to insert all the entries and let the 'Map' handle updates, the
-- acid-state event gets humongous. With my tests with only a few
-- feeds, each run uses about a megabyte of disk space. Multiply this
-- by 48 times a day, 365 times a year, you would get 17G a year.
--
-- Even though the save isn't now done in a single atomic operation,
-- this should be fine, because at worst we would be inserting
-- duplicates and the 'saveEntries' function already handles that.
unseenEntries fid s = do
  keys <- asks (foldMapOf (feeds . ix fid) M.keysSet)
  pure $ s `S.difference` keys

deriveSafeCopy 0 'base ''FeedMonadState

makeAcidic ''FeedMonadState
  [ 'saveEntry
  , 'getEntries
  , 'getEntry
  , 'saveEntries
  , 'countEntries
  , 'unseenEntries
  ]