diff --git a/tools/social-crossposting/Main.hs b/tools/social-crossposting/Main.hs index 555d63d9..ff7f2c58 100644 --- a/tools/social-crossposting/Main.hs +++ b/tools/social-crossposting/Main.hs @@ -48,12 +48,24 @@ hashtags = ["#haskell", "#haskellfoundation"] data NewsItem = NewsItem { niTitle :: T.Text + , niByline :: Byline , niBlurb :: T.Text -- ^ First paragraph, plain text. , niUrl :: T.Text -- ^ Canonical site URL, or the external `link` for a link-out item. } +{- | Who to credit, for the channels that name an author. A link-out item +(one with a `link` front matter field) points at somebody else's post, so +with no `author` field there is nobody we know to name: 'Unattributed' says +so loudly in the draft instead of crediting the HF for a post it didn't +write. +-} +data Byline + = Named T.Text + | HaskellFoundation + | Unattributed + main :: IO () main = do args <- getArgs @@ -91,9 +103,13 @@ loadNewsItem path = do title <- case metaText meta "title" of Just t -> pure t Nothing -> die (path ++ ": missing 'title' front matter") - let url = fromMaybe (T.pack (siteRoot dropExtension path <.> "html")) (metaText meta "link") - blurb = plainFirstPara blocks - pure NewsItem{niTitle = title, niBlurb = blurb, niUrl = url} + let linkOut = metaText meta "link" + url = fromMaybe (T.pack (siteRoot dropExtension path <.> "html")) linkOut + byline = case (metaText meta "author", linkOut) of + (Just author, _) -> Named author + (Nothing, Just _) -> Unattributed + (Nothing, Nothing) -> HaskellFoundation + pure NewsItem{niTitle = title, niByline = byline, niBlurb = plainFirstPara blocks, niUrl = url} metaText :: Meta -> T.Text -> Maybe T.Text metaText meta key = stringify <$> lookupMeta key meta @@ -114,42 +130,58 @@ plainFirstPara blocks = case runPure (writePlain plainOpts (Pandoc nullMeta (fir firstPara (b@Plain{} : _) = [b] firstPara (_ : bs) = firstPara bs --- PRESENTATION ------------------------------------------------------------- - --- | Terminal decoration switches, resolved once at startup. Colour and --- clickable links are emitted only for an interactive terminal, so piping --- to a file/pager yields clean plain text (the drafts stay copy-pasteable --- either way -- decoration lives only in the chrome, never in a draft body). -data Style = Style - { styColor :: Bool - , styLinks :: Bool +-- CHANNELS ------------------------------------------------------------------- + +-- | Where a channel sits in the social landscape; sets the tone expected +-- there as much as the mechanics of posting. +data ChannelKind + = Forum + | Microblog + | MailingList + | Newsletter + -- ^ Curated elsewhere: we propose an entry, its editors decide. + +-- | The markup a channel renders. +data Format + = Markdown + | PlainText + +-- | What bounds a channel's length. 'PostAtMost' is the only one the +-- generator enforces (via 'budgetedPost', which trims to the same number it +-- displays); the others are advisory, for the human writing the post. +data Length + = Unlimited + | PostAtMost Int + | TitleAtMost Int + +-- | Social norms that shape a draft but can't be checked mechanically. +data Etiquette + = ListEtiquette + -- ^ Plain-text list read by humans; a visibly automated blast reads badly. + | ImportantNewsOnly + -- ^ Curated by volunteers: propose the milestones, not every item. + +-- | How a draft for this channel must be shaped. Shown next to the channel +-- kind in the header. +data Constraint = Constraint + { conFormat :: Format + , conLength :: Length + , conEtiquette :: [Etiquette] } --- | Colour off when stdout is not a TTY or the standard @NO_COLOR@ env var is --- set; links off when not a TTY. -detectStyle :: IO Style -detectStyle = do - tty <- hIsTerminalDevice stdout - noColor <- lookupEnv "NO_COLOR" - pure Style{styColor = tty && isNothing noColor, styLinks = tty} - -- | Which account/identity to post from. This is the main thing a human has -- to get right, so each channel states it explicitly. data PostAs = AsHF | AsPrivate | AsPrivateEmail + | AsPrivateGitHub | AsUnknown data Channel = Channel { chName :: T.Text - , chKind :: T.Text - -- ^ "forum" / "microblog" / "mailing list". - , chConstraint :: T.Text - -- ^ Short note on the channel's main posting constraint (character - -- limit, format, etiquette), shown next to the kind. For a hard limit - -- that the draft also enforces, use the 'microblog' smart constructor so - -- the displayed number and the enforced budget share one source. + , chKind :: ChannelKind + , chConstraint :: Constraint , chUrl :: T.Text -- ^ Where to post; rendered as a clickable link. , chAccount :: PostAs @@ -158,67 +190,171 @@ data Channel = Channel -- cool, muted palette that is disjoint from the saturated traffic-light -- colours 'accountText' uses, so channel hue never clashes with the -- "who posts this" flag. - , chDraft :: NewsItem -> T.Text + , chDraft :: NewsItem -> Draft } --- | A microblog with a hard character limit. The limit feeds both the --- displayed constraint and the draft's budget, so the two can't drift. -microblog :: T.Text -> T.Text -> PostAs -> Int -> Int -> Channel -microblog name url account color limit = - Channel - { chName = name - , chKind = "microblog" - , chConstraint = "plain text \x00b7 \x2264 " <> T.pack (show limit) <> " chars" - , chUrl = url - , chAccount = account - , chColor = color - , chDraft = \NewsItem{niTitle, niBlurb, niUrl} -> withBudget limit niTitle niBlurb niUrl hashtags - } - channels :: [Channel] -channels = - [ Channel +channels = [discourse, reddit, twitterX, linkedIn, mastodon, haskellCafe, haskellWeekly] + +discourse :: Channel +discourse = + Channel { chName = "Discourse" - , chKind = "forum" - , chConstraint = "Markdown \x00b7 no length limit" + , chKind = Forum + , chConstraint = Constraint{conFormat = Markdown, conLength = Unlimited, conEtiquette = []} , chUrl = "https://discourse.haskell.org/c/haskell-foundation" , chAccount = AsPrivate , chColor = 74 - , chDraft = discourseDraft + , chDraft = \NewsItem{niTitle, niBlurb, niUrl} -> + [section "post" (T.unlines ["# " <> niTitle, "", niBlurb, "", niUrl])] } - , Channel + +reddit :: Channel +reddit = + Channel { chName = "Reddit" - , chKind = "forum" - , chConstraint = "Markdown \x00b7 title \x2264 300" + , chKind = Forum + , chConstraint = Constraint{conFormat = Markdown, conLength = TitleAtMost 300, conEtiquette = []} , chUrl = "https://www.reddit.com/r/haskell/" , chAccount = AsPrivate , chColor = 173 - , chDraft = redditDraft + , chDraft = \NewsItem{niTitle, niBlurb, niUrl} -> + [ section "title" niTitle + , section "link" niUrl + , section "suggested first comment" niBlurb + ] } - , microblog "Twitter/X" "https://twitter.com/haskellfound" AsHF 80 280 - , Channel + +twitterX :: Channel +twitterX = + Channel + { chName = "Twitter/X" + , chKind = Microblog + , chConstraint = Constraint{conFormat = PlainText, conLength = PostAtMost limit, conEtiquette = []} + , chUrl = "https://twitter.com/haskellfound" + , chAccount = AsHF + , chColor = 80 + , chDraft = \item -> [budgetedPost limit item] + } + where + limit = 280 + +{- | LinkedIn's limit is high enough that a news draft never approaches it, so +the blurb runs in full and the link gets an introduction instead of a budget. +-} +linkedIn :: Channel +linkedIn = + Channel { chName = "LinkedIn" - , chKind = "microblog" - , chConstraint = "plain text \x00b7 \x2264 3000 chars" + , chKind = Microblog + , chConstraint = Constraint{conFormat = PlainText, conLength = PostAtMost 3000, conEtiquette = []} , chUrl = "https://www.linkedin.com/company/haskell-foundation-inc" , chAccount = AsUnknown , chColor = 62 - , chDraft = linkedInDraft + , chDraft = \NewsItem{niTitle, niBlurb, niUrl} -> + [ section + "post" + (T.unlines [niTitle, "", niBlurb, "", "Read more: " <> niUrl, "", T.unwords hashtags]) + ] + } + +mastodon :: Channel +mastodon = + Channel + { chName = "Mastodon" + , chKind = Microblog + , chConstraint = Constraint{conFormat = PlainText, conLength = PostAtMost limit, conEtiquette = []} + , chUrl = "https://mastodon.social/@haskell_foundation" + , chAccount = AsHF + , chColor = 140 + , chDraft = \item -> [budgetedPost limit item] } - , microblog "Mastodon" "https://mastodon.social/@haskell_foundation" AsHF 140 500 - , Channel + where + limit = 500 + +haskellCafe :: Channel +haskellCafe = + Channel { chName = "haskell-cafe" - , chKind = "mailing list" - , chConstraint = "plain text \x00b7 list etiquette" + , chKind = MailingList + , chConstraint = Constraint{conFormat = PlainText, conLength = Unlimited, conEtiquette = [ListEtiquette]} , chUrl = "mailto:haskell-cafe@haskell.org" , chAccount = AsPrivateEmail , chColor = 66 - , chDraft = haskellCafeDraft + , chDraft = \NewsItem{niTitle, niBlurb, niUrl} -> + [ section "subject" niTitle + , section "body" (T.unlines [niBlurb, "", niUrl]) + ] } - ] +{- | Haskell Weekly is curated in a Git repository, so an entry is a pull +request against the issue being assembled -- @issue-NNN.markdown@ under the +current year. Its editors sort entries into the issue's sections, so the +draft is just the one list item, in their established shape. +-} +haskellWeekly :: Channel +haskellWeekly = + Channel + { chName = "Haskell Weekly" + , chKind = Newsletter + , chConstraint = Constraint{conFormat = Markdown, conLength = Unlimited, conEtiquette = [ImportantNewsOnly]} + , chUrl = "https://github.com/haskellweekly/haskellweekly/tree/main/data/newsletter" + , chAccount = AsPrivateGitHub + , chColor = 108 + , chDraft = \NewsItem{niTitle, niByline, niBlurb, niUrl} -> + [ section + "entry" + ( T.unlines + [ "- [" <> niTitle <> "](" <> niUrl <> ") by " <> bylineText niByline + , " > " <> niBlurb + ] + ) + ] + } + where + bylineText = \case + Named author -> author + HaskellFoundation -> "The Haskell Foundation" + Unattributed -> "?? (fill in who wrote it)" + +-- PRESENTATION ------------------------------------------------------------- + +{- | One block of a draft to copy as a whole. The label is chrome: it is +printed dim and indented, on its own line, while the block itself starts at +column 0 with blank lines around it -- so selecting by line or by block +grabs exactly the text to paste and nothing else. +-} +data Section = Section + { secLabel :: T.Text + , secBody :: T.Text + } + +type Draft = [Section] + +section :: T.Text -> T.Text -> Section +section secLabel secBody = Section{secLabel, secBody} + +-- | Terminal decoration switches, resolved once at startup. Colour and +-- clickable links are emitted only for an interactive terminal, so piping +-- to a file/pager yields clean plain text (the drafts stay copy-pasteable +-- either way -- decoration lives only in the chrome, never in a draft body). +data Style = Style + { styColor :: Bool + , styLinks :: Bool + } + +-- | Colour off when stdout is not a TTY or the standard @NO_COLOR@ env var is +-- set; links off when not a TTY. +detectStyle :: IO Style +detectStyle = do + tty <- hIsTerminalDevice stdout + noColor <- lookupEnv "NO_COLOR" + pure Style{styColor = tty && isNothing noColor, styLinks = tty} + +-- | Two blank lines between channels, so a channel's drafts read as one +-- group and the eye finds the next header without hunting. renderDrafts :: Style -> NewsItem -> String -renderDrafts s item = T.unpack . T.intercalate "\n\n" $ banner : map (renderChannel s item) channels +renderDrafts s item = T.unpack (T.intercalate "\n\n\n" (banner : map (renderChannel s item) channels) <> "\n") where banner = T.intercalate @@ -230,20 +366,37 @@ renderDrafts s item = T.unpack . T.intercalate "\n\n" $ banner : map (renderChan renderChannel :: Style -> NewsItem -> Channel -> T.Text renderChannel s item Channel{chName, chKind, chConstraint, chUrl, chAccount, chColor, chDraft} = - T.intercalate - "\n" - [ boldFg s chColor ("\x2501\x2501\x2501 " <> chName <> " ") <> fg s chColor (T.replicate (max 3 (24 - T.length chName)) "\x2501") <> " " <> dim s chKind <> constraint + T.intercalate "\n" (header ++ concatMap renderSection (chDraft item)) + where + header = + [ boldFg s chColor ("\x2501\x2501\x2501 " <> chName <> " ") <> fg s chColor (T.replicate (max 3 (24 - T.length chName)) "\x2501") <> " " <> dim s (kindText chKind) <> dim s " \x00b7 " <> fg s chColor (constraintText chConstraint) , " " <> dim s "account " <> accountText s chAccount , " " <> dim s "post at " <> link s chUrl (fg s chColor (displayUrl chUrl)) - , "" - , T.stripEnd (chDraft item) ] + renderSection Section{secLabel, secBody} = ["", " " <> dim s secLabel, "", T.stripEnd secBody] + +kindText :: ChannelKind -> T.Text +kindText = \case + Forum -> "forum" + Microblog -> "microblog" + MailingList -> "mailing list" + Newsletter -> "newsletter" + +-- | The channel's format, length limit and etiquette as one line of chrome. +constraintText :: Constraint -> T.Text +constraintText Constraint{conFormat, conLength, conEtiquette} = + T.intercalate " \x00b7 " ([formatText conFormat, lengthText conLength] ++ map etiquetteText conEtiquette) where - -- Kind stays dim; the constraint gets the channel's own hue so the - -- useful limit reads a touch louder without leaving the channel palette. - constraint - | T.null chConstraint = "" - | otherwise = dim s " \x00b7 " <> fg s chColor chConstraint + formatText = \case + Markdown -> "Markdown" + PlainText -> "plain text" + lengthText = \case + Unlimited -> "no length limit" + PostAtMost n -> "\x2264 " <> tshow n <> " chars" + TitleAtMost n -> "title \x2264 " <> tshow n + etiquetteText = \case + ListEtiquette -> "list etiquette" + ImportantNewsOnly -> "important news only" -- | Human-readable "who posts this" line, coloured as a traffic light: -- green = HF-owned/safe, yellow = unconfirmed, red = needs your personal @@ -254,16 +407,20 @@ accountText s = \case AsHF -> fg s 40 "Haskell Foundation account" AsPrivate -> boldFg s 203 "your PRIVATE account" AsPrivateEmail -> boldFg s 203 "your PRIVATE email address" + AsPrivateGitHub -> boldFg s 203 "your PRIVATE GitHub account (as a pull request)" AsUnknown -> boldFg s 220 "HF or private? \x2014 unconfirmed, check before posting" displayUrl :: T.Text -> T.Text displayUrl url = fromMaybe url (T.stripPrefix "mailto:" url) +tshow :: (Show a) => a -> T.Text +tshow = T.pack . show + -- ANSI helpers. Each is a no-op when the corresponding Style flag is off. sgr :: Style -> [Int] -> T.Text -> T.Text sgr Style{styColor} codes t - | styColor = "\ESC[" <> T.intercalate ";" (map (T.pack . show) codes) <> "m" <> t <> "\ESC[0m" + | styColor = "\ESC[" <> T.intercalate ";" (map tshow codes) <> "m" <> t <> "\ESC[0m" | otherwise = t bold :: Style -> T.Text -> T.Text @@ -285,50 +442,21 @@ link Style{styLinks} url label | styLinks = "\ESC]8;;" <> url <> "\ESC\\" <> label <> "\ESC]8;;\ESC\\" | otherwise = label --- DRAFTS --------------------------------------------------------------------- - -discourseDraft :: NewsItem -> T.Text -discourseDraft NewsItem{niTitle, niBlurb, niUrl} = - T.unlines ["# " <> niTitle, "", niBlurb, "", niUrl] - -redditDraft :: NewsItem -> T.Text -redditDraft NewsItem{niTitle, niBlurb, niUrl} = - T.unlines - [ "Title: " <> niTitle - , "Link: " <> niUrl - , "" - , "Suggested first comment:" - , niBlurb - ] - -linkedInDraft :: NewsItem -> T.Text -linkedInDraft NewsItem{niTitle, niBlurb, niUrl} = - T.unlines - [ niTitle - , "" - , niBlurb - , "" - , "Read more: " <> niUrl - , "" - , T.unwords hashtags - ] - -haskellCafeDraft :: NewsItem -> T.Text -haskellCafeDraft NewsItem{niTitle, niBlurb, niUrl} = - T.unlines ["Subject: " <> niTitle, "", niBlurb, "", niUrl] - --- | Assemble title/blurb/url/hashtags on their own lines, trimming the --- blurb (with an ellipsis) so the whole post fits `budget` characters. --- Title, url and hashtags are never trimmed. -withBudget :: Int -> T.Text -> T.Text -> T.Text -> [T.Text] -> T.Text -withBudget budget title blurb url tags = - let tagsLine = T.unwords tags - sep = "\n\n" :: T.Text - fixedLen = T.length title + T.length url + T.length tagsLine + 3 * T.length sep - blurbBudget = budget - fixedLen - blurb' - | blurbBudget <= 0 = "" - | T.length blurb <= blurbBudget = blurb - | otherwise = T.stripEnd (T.take (blurbBudget - 1) blurb) <> "\x2026" - post = T.intercalate sep (filter (not . T.null) [title, blurb', url, tagsLine]) - in post <> T.pack ("\n(" ++ show (T.length post) ++ "/" ++ show budget ++ " chars)") +{- | Assemble title/blurb/url/hashtags on their own lines, trimming the blurb +(with an ellipsis) so the whole post fits @limit@ characters. Title, url and +hashtags are never trimmed. The character count goes in the section's chrome +label rather than the body, so what you paste is exactly the post. +-} +budgetedPost :: Int -> NewsItem -> Section +budgetedPost limit NewsItem{niTitle, niBlurb, niUrl} = + section ("post \x00b7 " <> tshow (T.length post) <> "/" <> tshow limit <> " chars") post + where + tagsLine = T.unwords hashtags + sep = "\n\n" :: T.Text + fixedLen = T.length niTitle + T.length niUrl + T.length tagsLine + 3 * T.length sep + blurbBudget = limit - fixedLen + blurb + | blurbBudget <= 0 = "" + | T.length niBlurb <= blurbBudget = niBlurb + | otherwise = T.stripEnd (T.take (blurbBudget - 1) niBlurb) <> "\x2026" + post = T.intercalate sep (filter (not . T.null) [niTitle, blurb, niUrl, tagsLine]) diff --git a/tools/social-crossposting/README.md b/tools/social-crossposting/README.md index 2bcb8241..37719cda 100644 --- a/tools/social-crossposting/README.md +++ b/tools/social-crossposting/README.md @@ -1,8 +1,9 @@ # Social cross-posting draft generator Prints ready-to-copy-paste drafts of a news item for each external channel -(Discourse, Reddit, Twitter/X, LinkedIn, Mastodon, haskell-cafe). It only prints -text — there is no posting, no API keys, no bot behavior. +(Discourse, Reddit, Twitter/X, LinkedIn, Mastodon, haskell-cafe, Haskell +Weekly). It only prints text — there is no posting, no API keys, no bot +behavior. It's a second executable in the root `haskell-foundation.cabal` (not a separate package): it re-parses the news item's front matter + first @@ -19,11 +20,16 @@ cabal run social-draft -- hiw-hew-2026-videos ``` Run from the repo root. Each channel gets a colour-coded header stating its -kind (forum / microblog / mailing list), **which account to post from**, and -a clickable link to the channel; below it is the plain draft body to copy. +kind (forum / microblog / mailing list / newsletter), its format and length +constraint, **which account to post from**, and a clickable link to the +channel. -Copy only the draft body (between the header and the next header) — the -coloured chrome is never part of what you paste. +Below the header come the draft's sections — `title`, `link`, `post`, `body`, +… — each an indented dim label on its own line, then the text itself at +column 0 with blank lines around it. So a line- or block-select grabs exactly +what you paste and never a label: everything indented or coloured is chrome, +including the microblog character count, which sits in the `post` label +rather than in the post. ## Which account @@ -32,8 +38,9 @@ The header's `account` line says who should post: - **Haskell Foundation account** — the HF owns this channel. Currently Twitter/X ([@haskellfound](https://twitter.com/haskellfound)) and Mastodon ([@haskell_foundation](https://mastodon.social/@haskell_foundation)). -- **your PRIVATE account / email** — no HF identity here; post from your own - account (Discourse, Reddit) or send from your own address (haskell-cafe). +- **your PRIVATE account / email / GitHub account** — no HF identity here; + post from your own account (Discourse, Reddit), send from your own address + (haskell-cafe), or open the pull request yourself (Haskell Weekly). - **HF or private? — unconfirmed** — LinkedIn; not yet decided, check before posting. @@ -52,8 +59,17 @@ honours the standard `NO_COLOR` environment variable. - Hashtags are a single fixed set (`#haskell #haskellfoundation`) applied to every microblog; not yet varied per channel or per topic. - Twitter/Mastodon trimming cuts the blurb with an ellipsis to fit the char - budget (280 / 500); the reported char count is a slight overestimate when - the blurb is dropped entirely, so it will never come in over budget. + budget (280 / 500). Only the blurb is ever trimmed, so a title long enough + to blow the budget on its own comes out over — visibly, since the reported + count is exact (`301/280`). +- Only a whole-post limit is enforced; Reddit's title limit is displayed as + advice, not checked. +- The Haskell Weekly entry credits the `author` front matter field verbatim, + including any role ("Bryan Richter, DevOps Engineer") — the newsletter's own + style is bare names, so trim it when it reads oddly. Without an `author` + field it credits the HF for a site article, and prints a `??` placeholder + for a link-out (whoever wrote the linked post isn't recorded in the front + matter). - The canonical URL is the item's `link` front-matter field if present (link-out news items), otherwise `https://haskell.foundation/.html` mirroring `site.hs`'s route for that item — it isn't computed from the @@ -73,6 +89,12 @@ Microblogs: Mailing list: - haskell-cafe +Newsletter: +- [Haskell Weekly](https://github.com/haskellweekly/haskellweekly) — curated + in Git, so an entry is a pull request adding one Markdown list item to the + issue being assembled (`data/newsletter//issue-NNN.markdown`). Its + editors sort entries into the issue's sections. + ## Analysis — why not one "post everywhere" script The channels split into three tiers by how automatable they *should* be, @@ -91,3 +113,8 @@ which differs from how automatable they *can* be: A single "post everywhere" script concentrates the worst APIs, adds key-management + maintenance burden, and risks damaging automated posts to community spaces where tone matters. Rejected. + +Haskell Weekly is the one channel where automation is an option: a pull request +is reviewed by its editors before anything is published. If it ever becomes +routine, opening that pull request could be automated (`gh pr create` against +the current issue file).