{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Middleware where

import Data.Entry
import Control.Monad ((<=<))
import Data.ByteString.Lazy (ByteString)
import qualified Data.Foldable as F
import System.IO.Unsafe (unsafeInterleaveIO)
import Control.Lens
import Data.Set (Set)

-- I'm brainstorming an interface for tt-rss style interface for rss
-- feeds. The functionality of tt-rss is surprisingly good, it's the
-- UX that I'm having problems with. What I'm trying to do is provide
-- a similar featureset, but identifying the minimal functionality to
-- provide it.

-- In this file I'm trying out a middleware based solution. And at
-- least for pure values it seems to work quite well.
--
-- @
-- foo :: Middleware
-- foo = modifyScoreOnTag "haskell" (+10) .
--       modifyScoreOnTag "crypto" (\x -> x - 100)
-- @

-- XXX The IO should probably be restricted?
type Middleware = (URL -> IO Entry) -> (URL -> IO Entry)

-- * Low-level interface for the middlewares

edit :: (Entry -> Entry) -> Middleware
edit f g = fmap f . g

editM :: (Entry -> IO Entry) -> Middleware
editM f g = f <=< g

-- * High-level interface for the middleware

fetch :: URL -> f (Maybe a)
fetch = error "not defined yet"

-- | A lazy variant of unfolder
unfoldM :: (b -> IO (Maybe (a, b))) -> b -> IO [a]
unfoldM f = go
  where
    go b = do
      res <- unsafeInterleaveIO $ f b
      maybe (pure []) (\ (a,b') -> (a:) <$> go b') res

-- | A multipage middleware
--
-- Tries to fetch multiple pages and combine them together
-- @
-- multipage (has (url . _URL . prefixed "https://oglaf.com")) parser
-- @
multipage :: (Entry -> Bool) -> (ByteString -> Maybe URL) -> Middleware
multipage p f g u = do
  entry <- g u
  if p entry
    then multi entry
    else pure entry
  where
    multi entry = do
      pages <- take 10 <$> unfoldM go (Just (entryContent entry))
      pure $ entry{entryContent = F.fold pages "" }
    go Nothing = pure Nothing -- no page at all
    go (Just bs) =
      maybe
      (pure (Just ((bs <>), Nothing))) -- no next page
      (fmap (Just . ((bs <>),)) . fetch) -- next page
      (f bs)


-- | Modify the score
--
-- @
-- modifyScore (has (tags . ix (Tag "haskell"))) (+10) .
-- modifyScore (has (tags . ix (Tag "cryptocoin"))) (\x -> x - 100)
-- @
modifyScore :: (Entry -> Bool) -> (Int -> Int) -> Middleware
modifyScore p n = edit $
  over (filtered p . score) n

-- | Modify the tags
--
-- @
-- modifyTags (\e -> view title e =~ ("\\bhaskell\\b" :: String)) (S.insert (Tag "haskell")) .
-- modifyTags (\e -> view content e =~ ("\\bhaskell\\b" :: String)) (S.insert (Tag "haskell"))
-- @
modifyTags :: (Entry -> Bool) -> (Set Tag -> Set Tag) -> Middleware
modifyTags p t = edit $
  over (filtered p . tags) t