module Issue.Tag ( Tag (..), extractTags, internalTags, tagKey, tagValue, tagValuesOf, ) where import CMark qualified as D import Data.Binary (Binary) import Data.Maybe (catMaybes, mapMaybe) import Data.Text (Text, pack) import Data.Text qualified as T import Data.Time.Clock (UTCTime (utctDay)) import GHC.Generics (Generic) import Issue.Provenance (Author (..), Commit (..), Provenance (..)) 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 :: Text -> [Tag] extractTags = collect . D.commonmarkToNode [] 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 internalTags :: Text -> Maybe Provenance -> [T.Text] -> [Tag] internalTags title provenance' markers = concat [ [ Tag "id" $ Just $ toSpinalCase title, Tag "title" $ Just $ title ], maybe [] ( \provenance -> [ Tag "createdAt" $ Just $ pack $ show $ utctDay provenance.first.date, Tag "modifiedAt" $ Just $ pack $ show $ utctDay provenance.last.date, Tag "author" $ Just $ provenance.first.author.name, Tag "editor" $ Just $ provenance.last.author.name ] ) provenance', map (Tag "type" . Just) markers ] toSpinalCase :: Text -> Text toSpinalCase = T.replace " " "-" . T.filter keep . T.toLower where keep = (`elem` (concat [[' ', '-'], ['a' .. 'z'], ['0' .. '9']]))