module Issue.Tag
  ( Tag (..),
    extractTags,
    tagKey,
    tagValue,
    tagValuesOf,
    TagKey (..),
    TagValue (..),
  )
where

import CMark qualified as D
import Data.Binary (Binary)
import Data.List (intersperse)
import Data.Map qualified as M
import Data.Maybe (catMaybes, isJust, mapMaybe)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Render ((<<<))
import Render qualified as P

data Tag = Tag Text (Maybe Text) deriving (Show, Generic, Binary, Eq)

tagKey :: Tag -> Text
tagKey (Tag k _) = k

tagValue :: Tag -> Maybe Text
tagValue (Tag _ v) = v

tagValuesOf :: Text -> [Tag] -> [Text]
tagValuesOf key =
  mapMaybe
    ( \tag ->
        if tagKey tag == key
          then tagValue tag
          else Nothing
    )

extractTags :: [D.Node] -> [Tag]
extractTags = concatMap collect
  where
    collect (D.Node _ (D.CODE _) _) = []
    collect (D.Node _ (D.CODE_BLOCK _ _) _) = []
    collect (D.Node _ (D.TEXT s) ns) = extract s ++ concatMap collect ns
    collect (D.Node _ _ []) = []
    collect (D.Node _ _ ns) = concatMap collect ns

    extract =
      catMaybes
        . map
          ( ( \case
                ((T.uncons -> Just ('@', k)) : v) ->
                  case T.strip (T.unwords v) of
                    "" -> Just (Tag k Nothing)
                    v' -> Just (Tag k (Just v'))
                _ -> Nothing
            )
              . T.words
          )
        . T.lines

instance P.Render Tag where
  render tag
    | isJust (tagValue tag) = TagKey tag <<< (" " :: T.Text) <<< TagValue tag
    | otherwise = P.render (TagKey tag)

newtype TagKey = TagKey {unTagKey :: Tag}

instance P.Render TagKey where
  render (TagKey tag) =
    P.styled [P.bold, P.color P.Yellow] $
      P.render ("@" <> tagKey tag)

newtype TagValue = TagValue {unTagValue :: Tag}

instance P.Render TagValue where
  render (TagValue tag) =
    maybe P.emptyDoc (P.styled [P.color P.Yellow] . P.render) $
      tagValue tag

instance P.Render [Tag] where
  render tags =
    P.vsep $
      map
        ( \(tagKey, tagValues) ->
            TagKey (Tag tagKey Nothing)
              <<< (P.hcat . intersperse P.comma)
                (map (P.render . TagValue) (map (Tag tagKey . Just) tagValues))
        )
        tagsAndValues
    where
      tagsAndValues :: [(T.Text, [T.Text])]
      tagsAndValues =
        (M.toList . M.map S.toList)
          . foldl
            ( flip
                ( \tag ->
                    let vs = maybe S.empty S.singleton (tagValue tag)
                     in M.alter
                          (Just . maybe vs (S.union vs))
                          (tagKey tag)
                )
            )
            M.empty
          $ tags