From b2ee6c3c896e0d846efca05a8175f8aef5b28cf0 Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Thu, 30 Jul 2026 20:52:48 +0200 Subject: [PATCH] Improve social draft copy-pasting, add Haskell Weekly A draft is now a list of labelled sections rather than one text blob: the label is chrome (dim, indented) and the body starts at column 0 with blank lines around it, so a line or block selection grabs exactly what to paste. That also gets the microblog character count out of the post body, where it used to be pasted along with the text. Model what was stringly typed: Constraint (format, length limit, etiquette) and ChannelKind, which the new curated-newsletter channel needs anyway. The per-channel records replace the `microblog` smart constructor, whose positional arguments no longer said which Int was colour and which the limit. Haskell Weekly is a pull request against the issue being assembled, for important news only. Its entry names an author, so attribution becomes a Byline: a link-out item with no `author` field credits nobody rather than crediting the HF for someone else's post. --- tools/social-crossposting/Main.hs | 370 +++++++++++++++++++--------- tools/social-crossposting/README.md | 47 +++- 2 files changed, 286 insertions(+), 131 deletions(-) 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).