{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}

module MyLib (defaultMain, test) where

import AI
import Control.Lens (over, re, strict, view, (&), (.~), (^.))
import Data.Aeson (decode, encode)
import Data.Either (fromRight)
import Data.Maybe (fromMaybe)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Strict.Lens (utf8)
import Katip qualified as K
import M
import Options.Generic (Generic, ParseRecord (..), getRecord, unHelpful, type (<?>))
import Streamly.Data.Fold.Prelude qualified as Fold
import Streamly.Data.Stream.Prelude qualified as Stream
import Text.Pandoc (PandocError, def, readHtml, runPure, writeMarkdown)
import Wallabag

data Options = Options
  { full :: Bool <?> "Go through all the entries",
    verbose :: Bool
  }
  deriving (Generic, Show)

instance ParseRecord Options

tooShort :: Entry -> Bool
tooShort e = length (T.lines (view content e)) < 5

missingTags :: Entry -> Bool
missingTags Entry {_entryTags = []} = True
missingTags Entry {} = False

htmlToMarkdown :: Text -> Either PandocError Text
htmlToMarkdown input = runPure $ do
  doc <- readHtml def input
  writeMarkdown def doc

processableEntries :: (Monad m) => Stream.Stream m Entry -> Stream.Stream m Entry
processableEntries = Stream.filter (not . tooShort) . Stream.filter missingTags

markdownEntry :: (Monad m) => Stream.Stream m Entry -> Stream.Stream m Entry
markdownEntry = fmap (over content (\x -> fromRight x $ htmlToMarkdown x))

run :: K.Severity -> Scan -> IO ()
run sev scan = initialS sev $ \s -> do
  runM s $ do
    Stream.fold Fold.drain $
      sourceEntries scan
        & markdownEntry & processableEntries
        & Stream.parMapM (Stream.maxThreads 5) doWork

test :: IO ()
test = run K.DebugS Quick

suggestTags :: Text -> M [Text]
suggestTags txt = do
  c <- view creds
  let prompt =
        T.unlines
          [ "Assign tags for the given article from this set of tags: " <> encode hardLabels ^. strict . utf8,
            "Respond in JSON. Respond only in JSON, nothing more",
            "Example response: [\"Politics\"]",
            "",
            "The article contents:",
            txt
          ]
  unparsed <- completions c prompt
  pure $ maybe [] parseTags unparsed
  where
    parseTags :: Text -> [Text]
    parseTags = fromMaybe [] . decode . view (re utf8 . re strict) . T.dropWhileEnd (/= ']') . T.dropWhile (/= '[')

suggestTagsForEntry :: Entry -> M Entry
suggestTagsForEntry e = do
  newTags <- suggestTags (e ^. content)
  pure $ e & tags .~ newTags

doWork :: Entry -> M ()
doWork e = do
  entryWithTags <- suggestTagsForEntry e
  applyTags entryWithTags

hardLabels :: S.Set Text
hardLabels =
  S.fromList
    [ "Politics",
      "Writing",
      "Nature",
      "Camping",
      "Hiking",
      "Economics",
      "Climate",
      "Software",
      "Programming",
      "Maths",
      "Animals",
      "Health",
      "Sexuality",
      "Relationships",
      "Media and television",
      "Social media",
      "Gaming",
      "Plants",
      "Gadgets",
      "AI"
    ]



defaultMain :: IO ()
defaultMain = do
  opts <- getRecord "Wallabag tagger"
  let sev = severity opts
  if unHelpful $ full opts
    then run sev Full
    else run sev Quick
  where
    severity Options {verbose = True} = K.DebugS
    severity _ = K.InfoS