#!/usr/bin/env stack > -- stack script --resolver lts-22.6 --package text --package process yt.lhs: aggressively-compressed YouTube over gopher =================================================== A gopher applet that gateways YouTube at the lowest fidelity bytes still hold together. Two streaming pipelines and a transcript fetch --- no caching, no temp files, no state between requests. Path-info dispatch (Venusia 0.8.0.0+) keeps a single applet behind a virtual sub-tree of per-video URLs. The thesis is bandwidth austerity. The elevator pitch is curl gopher://gopher.someodd.zip/9/applets/fewbytes/yt.lhs/dQw4w9WgXcQ | mpv - --- a YouTube podcast player at the cost of a modem connection. (This file is markdown-flavoured literate Haskell. Headings use setext underlines rather than ATX-style `#` because GHC's literate parser interprets `#` at column 1 of a non-code line as the start of a pragma --- setext sidesteps that.) URL design ---------- `$SCRIPT` stands for whatever `routes.toml` mounts this file at; the script computes its own mount point from `$selector - $pathinfo` so substitute your own selector freely. $SCRIPT landing menu (search prompt) $SCRIPT + type-7 query search results OR, if the query is a pasted YouTube URL / bare id, a one-row direct group $SCRIPT/ audio stream (bare-id shortcut) $SCRIPT//audio audio: 6 kbps Opus mono in Ogg $SCRIPT//video video: 144p H.264 + 6 kbps Opus, MPEG-TS container $SCRIPT//text English auto-caption transcript $SCRIPT//menu gopher menu page for that video (same content as pasting its URL into the search box) Each search row emits five lines: an info-line header (`[duration] title --- uploader`) followed by four indented links (Listen / Watch / Read / Menu). The Menu link opens the per-video sub-menu at `$SCRIPT//menu` --- the same page you get when you paste a YouTube URL into the search box. From the command line --------------------- The examples below assume the production mount (`gopher.someodd.zip:70` + `/applets/fewbytes/yt.lhs`); substitute your own host and selector if you fork. The gopher item-type segment (`/9/`, `/0/`) is consumed by curl's URL parser and never reaches the server, so the same bytes come back regardless --- `9` and `0` are RFC 1436 hints for "binary" vs "text". Listen (the elevator pitch --- bare id defaults to audio): curl gopher://gopher.someodd.zip/9/applets/fewbytes/yt.lhs/dQw4w9WgXcQ | mpv - Watch: curl gopher://gopher.someodd.zip/9/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/video | mpv - Read (transcript prints to terminal): curl gopher://gopher.someodd.zip/0/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/text Save to disk instead of playing: curl gopher://gopher.someodd.zip/9/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/audio -o track.opus curl gopher://gopher.someodd.zip/9/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/video -o clip.ts Any libavformat-backed player works in place of `mpv -` (ffplay, vlc with `-` as input, etc.). For pure audio in the background: curl gopher://gopher.someodd.zip/9/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/audio \ | mpv --no-video --really-quiet - Hard dependencies on $PATH: `yt-dlp`, `ffmpeg` (with libopus and libx264), `curl`, `/bin/sh`. Haskell dependencies are `text` and `process` from the chosen LTS resolver; everything else is base. Running the doctests -------------------- Pure functions below carry `>>>` examples that doctest verifies. To run them: stack exec --resolver lts-22.6 \ --package doctest --package text --package process \ -- doctest -XOverloadedStrings yt.lhs `-XOverloadedStrings` is needed because doctest's GHCi session doesn't pick up the module's `LANGUAGE` pragmas. Module header and imports ------------------------- > {-# LANGUAGE OverloadedStrings #-} > module Main (main) where > > import Control.Exception (SomeException, try) > import Data.Char (isAlphaNum, isDigit) > import qualified Data.Text as T > import qualified Data.Text.IO as TIO > import System.Environment (getArgs, lookupEnv) > import System.Exit (ExitCode (..)) > import System.IO (BufferMode (..), hFlush, > hSetBuffering, hSetEncoding, > stdout, utf8) > import System.Process (readProcessWithExitCode, system) Defaults -------- Host/port overridable via `GOPHER_HOST` / `GOPHER_PORT` so the same script works on staging and production without editing. > defaultHost, defaultPort :: T.Text > defaultHost = "gopher.someodd.zip" > defaultPort = "70" > > searchLimit :: Int > searchLimit = 15 Request parsing --------------- Three positional argv slots, straight from `routes.toml`'s substitution surface (Venusia 0.8.0.0+): - argv[0] = `$selector` --- full selector that resolved here, including path-info - argv[1] = `$search` --- query after the tab; `""` when none - argv[2] = `$pathinfo` --- selector portion AFTER this script's filename (leading slash if non-empty) The script's self-link base is `$selector` with `$pathinfo` stripped off the end --- a one-line subtraction at request time. > data Req = Req > { reqSel :: T.Text > , reqQ :: T.Text > , reqP :: T.Text > } deriving Show > > -- | Parse the framework's argv into a 'Req'. Any extras past the > -- third position are ignored. Empty argv is a usage error. > -- > -- >>> parseArgs ["/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/audio", "", "/dQw4w9WgXcQ/audio"] > -- Req {reqSel = "/applets/fewbytes/yt.lhs/dQw4w9WgXcQ/audio", reqQ = "", reqP = "/dQw4w9WgXcQ/audio"} > -- > -- >>> parseArgs ["/applets/fewbytes/yt.lhs", "cat videos", ""] > -- Req {reqSel = "/applets/fewbytes/yt.lhs", reqQ = "cat videos", reqP = ""} > -- > -- >>> parseArgs ["/applets/fewbytes/yt.lhs", "q", "", "ignored"] > -- Req {reqSel = "/applets/fewbytes/yt.lhs", reqQ = "q", reqP = ""} > parseArgs :: [String] -> Req > parseArgs (s:q:p:_) = Req (T.pack s) (T.pack q) (T.pack p) > parseArgs (s:q:_) = Req (T.pack s) (T.pack q) T.empty > parseArgs [s] = Req (T.pack s) T.empty T.empty > parseArgs [] = error > "yt.lhs: missing argv[0] (gopher selector). \ > \When run by Venusia this is automatic ($selector in routes.toml); \ > \for manual testing pass it explicitly, e.g. \ > \`runghc yt.lhs /applets/fewbytes/yt.lhs '' '/dQw4w9WgXcQ/audio'`." > > data Ctx = Ctx > { ctxScriptSel :: T.Text > , ctxHost :: T.Text > , ctxPort :: T.Text > } Main dispatch ------------- Path-info is split into segments (empties dropped, so trailing slashes don't matter); the dispatch table routes on `(segs, hasQuery)`. Wrap `mainBody` in `try` so any thrown exception becomes a visible type-3 row instead of a blank response. The streaming paths invoke `system` against a `sh -c` pipeline; their output is binary and goes through the shell's stdout (inherited from us, in turn inherited from Venusia) directly to the gopher socket, with nothing buffered through Haskell. > main :: IO () > main = do > hSetBuffering stdout NoBuffering > hSetEncoding stdout utf8 > result <- try mainBody :: IO (Either SomeException ()) > case result of > Right () -> pure () > Left e -> mapM_ putLine > [ errorItem ("yt.lhs crashed: " <> T.pack (show e)) > , terminator > ] > > mainBody :: IO () > mainBody = do > req <- parseArgs <$> getArgs > host <- maybe defaultHost T.pack <$> lookupEnv "GOPHER_HOST" > port <- maybe defaultPort T.pack <$> lookupEnv "GOPHER_PORT" > let pinfo = reqP req > scriptSel = T.dropEnd (T.length pinfo) (reqSel req) > ctx = Ctx scriptSel host port > segs = filter (not . T.null) . T.splitOn "/" $ pinfo > query = T.strip (reqQ req) > hasQuery = not (T.null query) > case (segs, hasQuery) of > ([], False) -> landingMenu ctx > ([], True ) -> runQuery ctx query > ([vid], _ ) | validId vid -> streamAudio vid > ([vid, "audio"], _ ) | validId vid -> streamAudio vid > ([vid, "video"], _ ) | validId vid -> streamVideo vid > ([vid, "text"], _ ) | validId vid -> streamText vid > ([vid, "menu"], _ ) | validId vid -> videoMenu ctx vid > _ -> emitPathError ctx pinfo Gophermap line builders ----------------------- Every gophermap row ends with `\r\n` and passes its display field through `sanitize` so a stray byte from yt-dlp's output (or a user- typed query echoed back) can't smuggle a row break. > putLine :: T.Text -> IO () > putLine t = TIO.putStr (t <> "\r\n") >> hFlush stdout > > -- | Info-line row (item type @i@). > -- > -- >>> infoLine "hello" > -- "ihello\t\t\t0" > -- > -- >>> infoLine "with\ttab" > -- "iwith tab\t\t\t0" > infoLine :: T.Text -> T.Text > infoLine msg = "i" <> sanitize msg <> "\t\t\t0" > > -- | A typed menu row. > -- > -- >>> menuRow '1' "home" "/" "host" "70" > -- "1home\t/\thost\t70" > menuRow :: Char -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text > menuRow t display selector host port = > T.singleton t <> sanitize display <> "\t" <> selector > <> "\t" <> host <> "\t" <> port > > -- | Type-3 error row. > -- > -- >>> errorItem "nope" > -- "3nope\t\t\t0" > errorItem :: T.Text -> T.Text > errorItem msg = "3" <> sanitize msg <> "\t\t\t0" > > terminator :: T.Text > terminator = "." Sanitisation ------------ User-provided bytes (search queries, video titles echoed into menu rows) land inside display fields. Without scrubbing tabs / newlines, a value containing `"\tfake-selector\thost\t70"` would parse as extra fields on the wire and smuggle a fake menu item. > -- | Replace CR, LF, TAB with single spaces. > -- > -- >>> sanitize "ok" > -- "ok" > -- > -- >>> sanitize "with\ttab" > -- "with tab" > -- > -- >>> sanitize "newline\nhere" > -- "newline here" > sanitize :: T.Text -> T.Text > sanitize = T.map (\c -> if c == '\r' || c == '\n' || c == '\t' then ' ' else c) Self-link helpers ----------------- `selfLink` builds a path-info'd selector under this script's mount point. `backLink` is the "back to landing" row reused on error pages. > selfLink :: Ctx -> Char -> T.Text -> T.Text -> T.Text > selfLink ctx t display sub = > menuRow t display (ctxScriptSel ctx <> sub) (ctxHost ctx) (ctxPort ctx) > > backLink :: Ctx -> T.Text > backLink ctx = selfLink ctx '1' "back to landing" "" Streaming pipelines ------------------- The id reaches the shell only after `validId` accepts it (`[A-Za-z0-9_-]{11}`), so no shell metacharacter can survive into the command line. That is the only defense-in-depth claim this file makes --- read it before extending the schema. `hFlush stdout` before `system` is paranoia: with `NoBuffering` nothing should be buffered, but if a future edit introduces a Haskell write before a stream path, the flush guarantees those bytes land in front of the binary stream rather than after the shell's first packet. > -- | Run a yt-dlp | ffmpeg pipeline via @/bin/sh -c@. The @cd /tmp@ > -- prefix is load-bearing: yt-dlp's fragmented audio/video formats > -- (DASH, HLS) write @.part@ scratch files to the current working > -- directory before muxing to stdout, and Venusia's CWD for scripts > -- is the directory the .lhs lives in --- typically not writable by > -- the daemon's user. /tmp is mode 1777, so it always works. > runPipeline :: T.Text -> IO () > runPipeline pipeline = do > hFlush stdout > _ <- system ("cd /tmp && " ++ T.unpack pipeline) > pure () > > streamAudio :: T.Text -> IO () > streamAudio vid = runPipeline (audioPipeline vid) > > streamVideo :: T.Text -> IO () > streamVideo vid = runPipeline (videoPipeline vid) Audio: 6 kbps mono Opus at 12 kHz in voip mode. ~750 bytes/sec --- a 1-hour podcast costs ~2.7 MB. Speech stays intelligible; music turns to mush. > -- | Build the audio pipeline command. > -- > -- >>> audioPipeline "dQw4w9WgXcQ" > -- "yt-dlp -q --no-warnings --no-playlist -f worstaudio -o - -- dQw4w9WgXcQ | ffmpeg -loglevel error -i pipe:0 -vn -ac 1 -ar 12000 -c:a libopus -b:a 6k -application voip -f opus pipe:1" > audioPipeline :: T.Text -> T.Text > audioPipeline vid = T.unwords > [ "yt-dlp -q --no-warnings --no-playlist -f worstaudio -o - --", vid > , "| ffmpeg -loglevel error -i pipe:0 -vn -ac 1 -ar 12000" > , "-c:a libopus -b:a 6k -application voip -f opus pipe:1" > ] Video: 144p at 15 fps, H.264 at 32 kbps + Opus at 6 kbps. ~5 KB/sec. MPEG-TS container because its packets are self-synchronizing --- clients that drop and reconnect mid-stream resync cleanly. YouTube no longer publishes muxed (progressive) formats on the clients yt-dlp can authenticate as --- every entry comes back as either "video only" or "audio only". So we can't pipe a single yt-dlp stdout into ffmpeg the way `audioPipeline` does. Instead we ask yt-dlp for the two HLS manifest URLs (smallest video <= 144p plus smallest audio) with `-g`, then let ffmpeg fetch and mux them itself. The two `read`s split URLS on newline; `wv*+wa` is the yt-dlp selector that requires both branches to exist, so a partial match never produces a one-URL response that would silently drop a stream. > videoPipeline :: T.Text -> T.Text > videoPipeline vid = T.unwords > [ "URLS=$(yt-dlp -q --no-warnings --no-playlist" > , "-f 'wv*[height<=144]+wa/wv*+wa' -g --", vid <> ")" > , "&& VURL=$(printf '%s\\n' \"$URLS\" | sed -n 1p)" > , "&& AURL=$(printf '%s\\n' \"$URLS\" | sed -n 2p)" > , "&& ffmpeg -loglevel error -i \"$VURL\" -i \"$AURL\"" > , "-vf 'scale=-2:144,fps=15'" > , "-c:v libx264 -preset veryfast -tune zerolatency" > , "-b:v 32k -maxrate 40k -bufsize 80k" > , "-c:a libopus -b:a 6k -ac 1 -ar 12000 -application voip" > , "-f mpegts pipe:1" > ] Transcripts ----------- yt-dlp downloads the English caption track into a fresh @mktemp@ dir as TTML, runs its own post-processor to convert that to SRT, and we strip the SRT structure to plain text. One shell command end-to-end; the @rm -rf "$DIR"@ at the tail runs unconditionally (separated by @;@, not @&&@) so a partial yt-dlp failure still cleans up. Earlier yt-dlp releases (the @2025.04.30@ that ships with Debian 13) couldn't fetch YouTube's HLS-style timedtext segments at all through their built-in downloader, and an older revision of this file worked around that by walking the m3u8 with curl manually. From @2026.03.17@ onward the built-in subtitle path handles every shape (HLS, direct timedtext, even the @ip=0.0.0.0@-signed URLs the curl workaround couldn't reach). Keep yt-dlp upgraded or this regresses --- on Debian, install from the GitHub release into @/usr/local/bin@ so @yt-dlp -U@ keeps working. > streamText :: T.Text -> IO () > streamText vid = do > let v = T.unpack vid > cmd = unwords > [ "DIR=$(mktemp -d /tmp/ytlhs.XXXXXX);" > , "yt-dlp -q --no-warnings --no-playlist --skip-download" > , "--write-subs --write-auto-subs --sub-lang en" > , "--sub-format ttml --convert-subs srt" > , "-o \"$DIR/cap.%(ext)s\"" > , "--", v > , ">/dev/null 2>&1;" > , "cat \"$DIR\"/cap.*.srt 2>/dev/null;" > , "rm -rf \"$DIR\"" > ] > (_, out, _) <- readProcessWithExitCode "sh" ["-c", cmd] "" > let body = T.pack out > if T.null (T.strip body) > then TIO.putStrLn "(no English transcript available)" > else TIO.putStr (renderSrt body) > > -- | Strip SRT structure to bare per-cue text: drop sequence-number > -- lines (pure digits), timing lines (containing @ --> @), and HTML > -- tags (the @@ wrappers yt-dlp's TTML->SRT pass > -- leaves behind). Blank lines between cues collapse via the final > -- @filter (not . T.null)@ after tag stripping. > -- > -- >>> renderSrt "1\n00:00:01,360 --> 00:00:03,040\nhello\n\n2\n00:00:02,000 --> 00:00:04,000\nworld\n" > -- "hello\nworld\n" > -- > -- >>> renderSrt "" > -- "" > renderSrt :: T.Text -> T.Text > renderSrt = > T.unlines > . filter (not . T.null) > . map stripTags > . filter keep > . T.lines > where > keep t = let s = T.strip t > in not (T.null s) > && not (T.all isDigit s) > && not (" --> " `T.isInfixOf` s) > stripTags = T.pack . go . T.unpack > where > go [] = [] > go ('<':rs) = case dropWhile (/= '>') rs of > '>':rs' -> go rs' > _ -> [] > go (c:rs) = c : go rs Query box: search OR paste a URL -------------------------------- The type-7 box accepts either free-text search or a pasted YouTube URL / bare 11-char id. URL detection runs first: if the trimmed query parses as an id, or contains `youtube.com` / `youtu.be` plus one of the recognised prefixes (`v=`, `youtu.be/`, `/shorts/`, `/embed/`), we emit a one-row results group for that video. The domain guard prevents false positives where some unrelated string happens to contain `v=ELEVENCHARS`. Otherwise yt-dlp runs an actual `ytsearch15:` against YouTube. One HTTPS round-trip either way; no cached state between requests. > runQuery :: Ctx -> T.Text -> IO () > runQuery ctx q = case extractYouTubeId q of > Just vid -> videoMenu ctx vid > Nothing -> runSearch ctx q > > -- | Recognise pasted YouTube URLs or bare 11-char video ids. > -- > -- >>> extractYouTubeId "dQw4w9WgXcQ" > -- Just "dQw4w9WgXcQ" > -- > -- >>> extractYouTubeId "https://www.youtube.com/watch?v=dQw4w9WgXcQ&t=42" > -- Just "dQw4w9WgXcQ" > -- > -- >>> extractYouTubeId "https://youtu.be/dQw4w9WgXcQ" > -- Just "dQw4w9WgXcQ" > -- > -- >>> extractYouTubeId "https://www.youtube.com/shorts/dQw4w9WgXcQ" > -- Just "dQw4w9WgXcQ" > -- > -- >>> extractYouTubeId "cat videos" > -- Nothing > -- > -- >>> extractYouTubeId "v=fakefakefake" > -- Nothing > extractYouTubeId :: T.Text -> Maybe T.Text > extractYouTubeId s > | validId s = Just s > | isYouTubeLike s = tryPrefixes ["v=", "youtu.be/", "/shorts/", "/embed/"] > | otherwise = Nothing > where > isYouTubeLike t = "youtube.com" `T.isInfixOf` t > || "youtu.be" `T.isInfixOf` t > tryPrefixes [] = Nothing > tryPrefixes (p:ps) = case skipPast p s of > Just rest -> let cand = T.take 11 rest > in if validId cand then Just cand else tryPrefixes ps > Nothing -> tryPrefixes ps > > videoMenu :: Ctx -> T.Text -> IO () > videoMenu ctx vid = do > let spec = "%(id)s\t%(title)s\t%(uploader)s\t%(duration_string)s" > (ec, out, _) <- readProcessWithExitCode "yt-dlp" > [ "-q", "--no-warnings", "--skip-download", "--print", spec > , "--", T.unpack vid > ] "" > case ec of > ExitSuccess -> mapM_ (resultGroup ctx) (T.lines (T.pack out)) > _ -> putLine (infoLine "(video not found or unavailable)") > let portPart = if ctxPort ctx == "70" then "" else ":" <> ctxPort ctx > menuUri = "gopher://" <> ctxHost ctx <> portPart > <> "/1" <> ctxScriptSel ctx <> "/" <> vid <> "/menu" > putLine (selfLink ctx '1' ("Menu URI: " <> menuUri) ("/" <> vid <> "/menu")) > mapM_ putLine (playHint ctx (Just vid)) > putLine terminator > > runSearch :: Ctx -> T.Text -> IO () > runSearch ctx q = do > let q' = T.take 200 q > query = "ytsearch" <> T.pack (show searchLimit) <> ":" <> q' > spec = "%(id)s\t%(title)s\t%(uploader)s\t%(duration_string)s" > (ec, out, _) <- readProcessWithExitCode "yt-dlp" > [ "-q", "--no-warnings", "--flat-playlist", "--print", spec > , "--", T.unpack query > ] "" > let resultLines = filter (not . T.null) (T.lines (T.pack out)) > case ec of > ExitSuccess | null resultLines -> putLine (infoLine "(no results)") > ExitSuccess -> mapM_ (resultGroup ctx) resultLines > _ -> putLine (infoLine "(search failed)") > mapM_ putLine (playHint ctx Nothing) > putLine terminator > > -- | Four-line preamble teaching the reader how to pipe a selector > -- into a player, emitted at the end of every results page. Called > -- with @Just vid@ on the video-menu page (the id is concrete and > -- the URLs are copy-pasteable) and with @Nothing@ on search results > -- (15 ids, so we use a @@ placeholder). > playHint :: Ctx -> Maybe T.Text -> [T.Text] > playHint ctx mvid = > let (idPart, note) = case mvid of > Just v -> (v, "") > Nothing -> ("", " (replace with the id segment of any " > <> "Listen/Watch selector above)") > -- A gopher URL is `gopher://host[:port]/`: > -- the first byte of the path after the host's `/` is the > -- item-type hint, not part of the selector. Without `/9` > -- inserted here, curl reads the `a` of `/applets/...` as the > -- type and sends `pplets/...` to the server, which 404s. > portPart = if ctxPort ctx == "70" then "" else ":" <> ctxPort ctx > urlBase = "gopher://" <> ctxHost ctx <> portPart > <> "/9" <> ctxScriptSel ctx <> "/" <> idPart > in [ infoLine "" > , infoLine ("Play in a shell" <> note <> ":") > , infoLine (" curl " <> urlBase <> "/audio | mpv -") > , infoLine (" curl " <> urlBase <> "/video | mpv -") > , infoLine "(ffplay / vlc / any libavformat player works too.)" > ] > > -- | One per-video group in a results page. The title line is a > -- gopher type-@h@ row whose selector is @URL:https://...@ --- the > -- de-facto convention for HTML links in gophermaps; clients that > -- recognise it (lynx, bombadillo, gopher-cli, etc.) open the URL > -- in a browser when the title is clicked. Below it are four > -- indented rows: three streaming endpoints (Listen/Watch/Read) > -- plus a `Menu` link to the per-video gopher menu at @/menu@. > resultGroup :: Ctx -> T.Text -> IO () > resultGroup ctx row = case T.splitOn "\t" row of > [vid, title, uploader, dur] | validId vid -> do > let base = "/" <> vid <> "/" > ytUrl = "URL:https://www.youtube.com/watch?v=" <> vid > label = rowHeader dur title uploader > putLine (menuRow 'h' label ytUrl (ctxHost ctx) (ctxPort ctx)) > putLine (selfLink ctx '9' " Listen" (base <> "audio")) > putLine (selfLink ctx '9' " Watch" (base <> "video")) > putLine (selfLink ctx '0' " Read" (base <> "text")) > putLine (selfLink ctx '1' " Menu" (base <> "menu")) > putLine (infoLine "") > _ -> pure () > > -- | Build a result-group header line. > -- > -- >>> rowHeader "4:32" "Hello" "Channel" > -- "[4:32] Hello --- Channel" > -- > -- >>> rowHeader "" "Hello" "" > -- "[?:??] Hello" > rowHeader :: T.Text -> T.Text -> T.Text -> T.Text > rowHeader dur title uploader = > let durTag = "[" <> (if T.null dur then "?:??" else dur) <> "] " > by = if T.null uploader then "" else " --- " <> uploader > in T.take 78 (durTag <> title <> by) Landing ------- Three info lines and one search link. The page steps out of the way of the search box. > landingMenu :: Ctx -> IO () > landingMenu ctx = mapM_ putLine > [ infoLine "yt.lhs --- lowest-quality YouTube over gopher." > , infoLine "Enter a search query or paste a YouTube URL." > , infoLine "" > , selfLink ctx '7' "Search" "" > , terminator > ] Path-info error --------------- Anything that doesn't match the dispatch table. > emitPathError :: Ctx -> T.Text -> IO () > emitPathError ctx pinfo = mapM_ putLine > [ errorItem ("Unrecognised path-info: " <> pinfo) > , backLink ctx > , terminator > ] Helpers ------- > -- | YouTube id grammar: 11 chars, base64url alphabet. > -- > -- >>> validId "dQw4w9WgXcQ" > -- True > -- > -- >>> validId "tooshort" > -- False > -- > -- >>> validId "has space!!" > -- False > -- > -- >>> validId "abc_def_ghi" > -- True > validId :: T.Text -> Bool > validId s = T.length s == 11 && T.all idChar s > where idChar c = isAlphaNum c || c == '_' || c == '-' > > -- | Return everything after the first occurrence of @pat@, or > -- @Nothing@ if @pat@ does not appear. > -- > -- >>> skipPast "v=" "watch?v=ABC" > -- Just "ABC" > -- > -- >>> skipPast "v=" "no match" > -- Nothing > skipPast :: T.Text -> T.Text -> Maybe T.Text > skipPast pat s = case T.breakOn pat s of > (_, rest) | T.null rest -> Nothing > | otherwise -> Just (T.drop (T.length pat) rest)