#!/usr/bin/env stack > -- stack script --resolver lts-22.6 --package text --package bytestring --package directory --package filepath --package time --package process qdbviewer.lhs: a gopherspace quote database ============================================ The read side of qdb --- a Gopher <-> IRC bridge. An always-on `ii` logger sits in `#main` on `irc.someodd.zip`; when someone types `.qdb N` the watcher snapshots the last N lines of channel buffer into `quotes/.txt`. This applet is how gopherspace reads those snapshots back: an index, per-quote menus, a plain-text render, and a Microsoft Comic Chat strip render. The directory of `.txt` files *is* the database --- no schema, no SQLite. Each file is self-contained: a setext header block (saver, channel, network, date, line count) followed by a blank line and the raw transcript. Raw `.txt` browsing is served by Venusia's own `[[files]]` block; this script only renders menus and the comic. (This file is markdown-flavoured literate Haskell. Headings use setext underlines rather than ATX-style `#` because GHC's literate parser treats a `#` at column 1 of a non-code line as a pragma --- setext sidesteps that.) URL design ---------- `$SCRIPT` is whatever `routes.toml` mounts this file at; the script computes its own mount point from `$selector` minus `$pathinfo`, so the layout works under any selector. $SCRIPT landing --- latest quotes + browse + random $SCRIPT/browse full index, newest first $SCRIPT/random a random quote's menu $SCRIPT/q/ per-quote menu (text / comic / raw + permalink) $SCRIPT/q//txt the quote rendered as plain gopher text $SCRIPT/q//comic Microsoft Comic Chat strip (PNG), lazily rendered via the `qdb-comic` shim and cached beside the `.txt` as `.comic.png` `` is always all-digits; anything else is rejected before it can reach the filesystem. Anything else under path-info falls through to a type-3 error row. From the command line --------------------- curl gopher://gopher.someodd.zip/1/applets/qdb/qdbviewer.lhs curl gopher://gopher.someodd.zip/1/applets/qdb/qdbviewer.lhs/q/0001 curl gopher://gopher.someodd.zip/0/applets/qdb/qdbviewer.lhs/q/0001/txt curl gopher://gopher.someodd.zip/I/applets/qdb/qdbviewer.lhs/q/0001/comic > 0001.png Running the doctests -------------------- Pure helpers below carry `>>>` examples that doctest verifies: stack exec --resolver lts-22.6 \ --package doctest \ --package text --package bytestring --package directory \ --package filepath --package time --package process \ -- doctest -XOverloadedStrings qdbviewer.lhs `-XOverloadedStrings` is needed because doctest's GHCi session does not pick up the module's `LANGUAGE` pragma. Module header and imports ------------------------- > {-# LANGUAGE OverloadedStrings #-} > module Main (main) where > > import Control.Exception (SomeException, try) > import Data.Char (isDigit) > import Data.List (sortOn) > import Data.Maybe (catMaybes, fromMaybe) > import qualified Data.ByteString as BS > import qualified Data.Text as T > import qualified Data.Text.Encoding as TE > import qualified Data.Text.Encoding.Error as TEE > import qualified Data.Text.IO as TIO > import Data.Time.Clock.POSIX (getPOSIXTime) > import System.Directory (createDirectoryIfMissing, > doesDirectoryExist, doesFileExist, > listDirectory) > import System.Environment (getArgs, lookupEnv) > import System.Exit (ExitCode (..)) > import System.FilePath ((), dropExtension, takeExtension) > import System.IO (BufferMode (..), IOMode (..), > hSetBuffering, hSetEncoding, stdout, > utf8, withFile) > import System.Process (StdStream (..), createProcess, proc, > std_out, waitForProcess) > import Text.Read (readMaybe) Configuration ------------- `GOPHER_HOST` / `GOPHER_PORT` are overridable via environment so the same script runs on staging and production unedited. The numeric knobs are deliberately hardcoded --- an applet's tuning is part of its source, not its deployment. > defaultHost, defaultPort :: T.Text > defaultHost = "gopher.someodd.zip" > defaultPort = "70" > > quotesDir :: FilePath > quotesDir = "quotes" -- relative to the script's CWD (set by Venusia) > > comicCmd :: FilePath > comicCmd = "./qdb-comic" -- the Comic Chat render shim, beside this script > > latestCount :: Int > latestCount = 8 -- quotes shown in the landing's "latest" block Request parsing --------------- Venusia passes positional argv: `$selector`, `$search`, `$pathinfo` (and, if the routes block forwards it, `$remote_ip`, which the viewer ignores). The cons-pattern `parseArgs` degrades gracefully for manual testing and aborts loudly on empty argv --- the script cannot invent its own mount point. > data Req = Req > { reqSel :: T.Text -- ^ full selector that resolved here > , reqQ :: T.Text -- ^ search text after the tab, or empty > , reqP :: T.Text -- ^ selector portion after this script's filename > } deriving (Eq, Show) > > -- | Parse the framework's argv into a 'Req'. Extras past the third > -- position are ignored; empty argv is a usage error. > -- > -- >>> parseArgs ["/applets/qdb/qdbviewer.lhs/q/0007", "", "/q/0007"] > -- Req {reqSel = "/applets/qdb/qdbviewer.lhs/q/0007", reqQ = "", reqP = "/q/0007"} > -- > -- >>> parseArgs ["/applets/qdb/qdbviewer.lhs", "", ""] > -- Req {reqSel = "/applets/qdb/qdbviewer.lhs", reqQ = "", reqP = ""} > -- > -- >>> parseArgs ["/applets/qdb/qdbviewer.lhs", "", "/random", "10.0.0.1"] > -- Req {reqSel = "/applets/qdb/qdbviewer.lhs", reqQ = "", reqP = "/random"} > 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 > "qdbviewer.lhs: missing argv[0] (gopher selector). When run by Venusia \ > \this is automatic; for manual testing pass it explicitly, e.g. \ > \`runghc qdbviewer.lhs /applets/qdb/qdbviewer.lhs '' '/q/0001'`." > > data Ctx = Ctx > { ctxScriptSel :: T.Text -- ^ selector path to this script, no path-info > , ctxHost :: T.Text > , ctxPort :: T.Text > } The quote model --------------- A `Quote` is one snapshot file. The header fields are display-only, kept as `Text`; missing fields parse to empty and render as `?`. > data Quote = Quote > { qId :: T.Text > , qSavedBy :: T.Text > , qChannel :: T.Text > , qNetwork :: T.Text > , qDate :: T.Text > , qLineCount :: T.Text > , qBody :: [T.Text] -- ^ raw transcript lines > } deriving (Eq, Show) File-format parsing ------------------- The on-disk shape is a title line (`qdb #`), a setext underline, a block of `key: value` header lines, a blank line, then the raw transcript: qdb #0042 ========= saved-by: alice channel: #main network: irc.someodd.zip date: 2026-05-14T17:30:00Z lines: 10 2026-05-14 17:29 it compiled on my machine i swear 2026-05-14 17:29 your machine is a liar `dropTitle` peels the title + underline when present (a file pointed here without them still parses --- the header block is just read from the top). `breakOnBlank` splits header from body at the first blank line. `parseQuote` ties them together; it is total and tolerant --- a malformed file still renders *something* rather than 500-ing. > -- | >>> dropTitle ["qdb #0001", "=========", "saved-by: x"] > -- ["saved-by: x"] > -- > -- >>> dropTitle ["saved-by: x", "channel: #y"] > -- ["saved-by: x","channel: #y"] > -- > -- >>> dropTitle [] > -- [] > dropTitle :: [T.Text] -> [T.Text] > dropTitle (l0:l1:rest) > | "qdb #" `T.isPrefixOf` l0 && isUnderline l1 = rest > dropTitle ls = ls > > -- | A setext underline: a non-empty run of @=@ (after trimming). > -- > -- >>> isUnderline "====" > -- True > -- > -- >>> isUnderline " == " > -- True > -- > -- >>> isUnderline "" > -- False > -- > -- >>> isUnderline "= x" > -- False > isUnderline :: T.Text -> Bool > isUnderline t = not (T.null t') && T.all (== '=') t' > where t' = T.strip t > > -- | Split a line list into (header lines, body lines) at the first > -- blank line; the blank itself is dropped. No blank line means it is > -- all header. > -- > -- >>> breakOnBlank ["a: 1", "b: 2", "", "body one", "body two"] > -- (["a: 1","b: 2"],["body one","body two"]) > -- > -- >>> breakOnBlank ["x: 1"] > -- (["x: 1"],[]) > breakOnBlank :: [T.Text] -> ([T.Text], [T.Text]) > breakOnBlank ls = > let (hdr, rest) = break (T.null . T.strip) ls > in (hdr, drop 1 rest) > > -- | Parse a header line @"key: value"@ into a trimmed pair. Lines > -- with no colon return 'Nothing'. Only the first colon splits, so > -- values may themselves contain colons (timestamps, URLs). > -- > -- >>> parseHeaderLine "saved-by: alice" > -- Just ("saved-by","alice") > -- > -- >>> parseHeaderLine "date: 2026-05-14T17:30:00Z" > -- Just ("date","2026-05-14T17:30:00Z") > -- > -- >>> parseHeaderLine "no colon here" > -- Nothing > parseHeaderLine :: T.Text -> Maybe (T.Text, T.Text) > parseHeaderLine l = > let (k, v) = T.breakOn ":" l > in if T.null v > then Nothing > else Just (T.strip k, T.strip (T.drop 1 v)) > > -- | Parse a snapshot file's contents into a 'Quote'. Tolerant: > -- unknown header keys are ignored, missing ones become empty. > -- > -- >>> qBody (parseQuote "0007" "qdb #0007\n====\nsaved-by: al\nchannel: #main\n\nline a\nline b") > -- ["line a","line b"] > -- > -- >>> qSavedBy (parseQuote "0007" "saved-by: al\n\nbody") > -- "al" > -- > -- >>> qChannel (parseQuote "0007" "saved-by: al\n\nbody") > -- "" > parseQuote :: T.Text -> T.Text -> Quote > parseQuote qid content = > let (hdr, body) = breakOnBlank (dropTitle (T.lines content)) > kv = catMaybes (map parseHeaderLine hdr) > look k = fromMaybe "" (lookup k kv) > in Quote > { qId = qid > , qSavedBy = look "saved-by" > , qChannel = look "channel" > , qNetwork = look "network" > , qDate = look "date" > , qLineCount = look "lines" > , qBody = body > } Id discipline and paths ----------------------- `` from path-info is attacker-controlled. `validId` is the single chokepoint: an id must be a non-empty run of ASCII digits before it is ever spliced into a `FilePath`, so `../` and friends cannot occur. > -- | >>> validId "0042" > -- True > -- > -- >>> validId "" > -- False > -- > -- >>> validId "12a" > -- False > -- > -- >>> validId "../etc/passwd" > -- False > validId :: T.Text -> Bool > validId t = not (T.null t) && T.all isDigit t > > quotePath :: T.Text -> FilePath > quotePath qid = quotesDir (T.unpack qid ++ ".txt") > > comicPath :: T.Text -> FilePath > comicPath qid = quotesDir (T.unpack qid ++ ".comic.png") Listing and reading -------------------- `listQuoteIds` returns every snapshot id, newest (highest) first --- `.comic.png` siblings and any stray files are filtered out by the "`.txt` extension AND all-digit stem" rule. `readQuote` is the only reader; it re-runs `validId` so it is safe to call on raw path-info. > -- | >>> sortDescNumeric ["0001", "0010", "0002"] > -- ["0010","0002","0001"] > sortDescNumeric :: [T.Text] -> [T.Text] > sortDescNumeric = sortOn (\i -> negate (fromMaybe 0 (readIntT i))) > > readIntT :: T.Text -> Maybe Int > readIntT = readMaybe . T.unpack > > listQuoteIds :: IO [T.Text] > listQuoteIds = do > exists <- doesDirectoryExist quotesDir > if not exists > then pure [] > else do > files <- listDirectory quotesDir > let ids = [ T.pack stem > | f <- files > , takeExtension f == ".txt" > , let stem = dropExtension f > , not (null stem) > , all isDigit stem > ] > pure (sortDescNumeric ids) > > readQuote :: T.Text -> IO (Maybe Quote) > readQuote qid > | not (validId qid) = pure Nothing > | otherwise = do > let p = quotePath qid > ok <- doesFileExist p > if not ok > then pure Nothing > else do > bs <- BS.readFile p > pure (Just (parseQuote qid (TE.decodeUtf8With TEE.lenientDecode bs))) Main dispatch ------------- Path-info is split into segments (empties dropped, so trailing slashes don't matter). Menu-producing branches are wrapped in 'runMenu' so any exception becomes a visible type-3 row rather than a blank body. The `/comic` branch runs bare: it does all its validation *before* the first PNG byte hits stdout, and once binary output has started there is no switching back to gophermap mode. > main :: IO () > main = do > hSetBuffering stdout NoBuffering > hSetEncoding stdout utf8 > createDirectoryIfMissing True quotesDir > 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 > case segs of > [] -> runMenu (emitLanding ctx) > ["browse"] -> runMenu (emitBrowse ctx) > ["random"] -> runMenu (emitRandom ctx) > ["q", i] -> runMenu (withQuote ctx i (emitQuoteMenu ctx)) > ["q", i, "txt"] -> runMenu (withQuote ctx i emitQuoteText) > ["q", i, "comic"] -> emitQuoteComic ctx i > _ -> runMenu (emitPathError ctx pinfo) > > -- | Run a menu-producing action with crash safety: any uncaught > -- exception becomes a type-3 row + terminator instead of a blank > -- response. Never wrap a binary stream this way. > runMenu :: IO () -> IO () > runMenu action = do > result <- try action :: IO (Either SomeException ()) > case result of > Right () -> pure () > Left e -> mapM_ putLine > [ errorItem ("qdbviewer.lhs crashed: " <> T.pack (show e)) > , terminator > ] > > -- | Look up a quote by raw path-info id and hand it to a continuation, > -- or emit a "not found" menu (covers both a bad id and a missing file). > withQuote :: Ctx -> T.Text -> (Quote -> IO ()) -> IO () > withQuote ctx i k = do > mq <- readQuote i > case mq of > Just q -> k q > Nothing -> emitNotFound ctx i Landing and index ----------------- The landing is sparse: it routes to the per-quote menus and the browse/random entry points, and previews the latest few. It does not duplicate per-quote affordances --- the per-quote menu is the canonical surface. > emitLanding :: Ctx -> IO () > emitLanding ctx = do > ids <- listQuoteIds > latest <- catMaybes <$> mapM readQuote (take latestCount ids) > mapM_ putLine $ > [ infoLine "qdb --- the gopherspace quote database" > , infoLine "Lines plucked from IRC, kept as plain text." > , infoLine "" > , menuLine ("Browse all quotes (" <> tshow (length ids) <> ")") > (link ctx "/browse") (ctxHost ctx) (ctxPort ctx) > , menuLine "Random quote" (link ctx "/random") (ctxHost ctx) (ctxPort ctx) > , infoLine "" > ] ++ > (if null ids > then [ infoLine "Nothing saved yet. In #main on irc.someodd.zip, type:" > , infoLine " .qdb 10" > , infoLine "to immortalise the last 10 lines of channel buffer." > ] > else infoLine "latest:" : map (quoteRow ctx) latest) > ++ [ terminator ] > > emitBrowse :: Ctx -> IO () > emitBrowse ctx = do > ids <- listQuoteIds > qs <- catMaybes <$> mapM readQuote ids > mapM_ putLine $ > [ infoLine ("qdb --- all quotes (" <> tshow (length ids) <> "), newest first") > , infoLine "" > ] ++ > (if null qs then [infoLine "Nothing saved yet."] else map (quoteRow ctx) qs) > ++ > [ infoLine "" > , menuLine "Browse the raw quotes/ directory" (quotesSel ctx) > (ctxHost ctx) (ctxPort ctx) > , menuLine "Back to qdb" (ctxScriptSel ctx) (ctxHost ctx) (ctxPort ctx) > , terminator > ] > > -- | A pseudo-random pick. Process-per-request means no in-memory RNG > -- state; POSIX microseconds modulo the count is "random enough" for > -- a quote roulette. > emitRandom :: Ctx -> IO () > emitRandom ctx = do > ids <- listQuoteIds > case ids of > [] -> emitLanding ctx > _ -> do > t <- getPOSIXTime > let n = floor (t * 1000000) :: Integer > idx = fromInteger (n `mod` fromIntegral (length ids)) > withQuote ctx (ids !! idx) (emitQuoteMenu ctx) > > -- | One menu row for the landing / browse lists: a type-1 link to > -- the quote's menu, labelled with id, short date, and a body preview. > quoteRow :: Ctx -> Quote -> T.Text > quoteRow ctx q = > menuLine label (link ctx ("/q/" <> qId q)) (ctxHost ctx) (ctxPort ctx) > where > label = "#" <> qId q <> " " <> T.take 10 (qDate q) > <> " " <> truncateText 48 (firstBodyLine q) Per-quote menu and renders -------------------------- The per-quote menu links to the three render modes. The comic link points straight at the cached `.comic.png` (served by the `[[files]]` block) when it already exists, and at the lazy-rendering `/q//comic` selector otherwise --- so the first viewer pays the render cost and everyone after gets the static file. > emitQuoteMenu :: Ctx -> Quote -> IO () > emitQuoteMenu ctx q = do > let qid = qId q > cached <- doesFileExist (comicPath qid) > let comicSel = if cached > then quotesSel ctx <> "/" <> qid <> ".comic.png" > else link ctx ("/q/" <> qid <> "/comic") > mapM_ putLine > [ infoLine ("qdb #" <> qid) > , infoLine "" > , infoLine ("saved by " <> orUnknown (qSavedBy q) > <> " in " <> orUnknown (qChannel q) > <> " on " <> orUnknown (qNetwork q)) > , infoLine (orUnknown (qDate q) <> " --- " > <> orUnknown (qLineCount q) <> " lines") > , infoLine "" > , textLine "Read as text" (link ctx ("/q/" <> qid <> "/txt")) > (ctxHost ctx) (ctxPort ctx) > , imageLine "View as Microsoft Comic Chat strip" comicSel > (ctxHost ctx) (ctxPort ctx) > , textLine "Raw .txt file" (quotesSel ctx <> "/" <> qid <> ".txt") > (ctxHost ctx) (ctxPort ctx) > , infoLine "" > , infoLine ("Permalink: " <> gopherUrl ctx '1' ("/q/" <> qid)) > , infoLine "" > , menuLine "Back to qdb" (ctxScriptSel ctx) (ctxHost ctx) (ctxPort ctx) > , terminator > ] > > -- | Plain-text render (gopher item type 0). No gophermap rows --- > -- just a human header and the verbatim transcript. > emitQuoteText :: Quote -> IO () > emitQuoteText q = TIO.putStr $ T.intercalate "\r\n" $ > [ "qdb #" <> qId q > , "saved by " <> orUnknown (qSavedBy q) <> " in " <> orUnknown (qChannel q) > <> " on " <> orUnknown (qNetwork q) > , orUnknown (qDate q) > , "" > ] ++ qBody q ++ [ "" ] The comic render path --------------------- `/q//comic` serves a Microsoft Comic Chat strip as gopher item type `I`. If the PNG is already cached beside the `.txt` it is streamed straight out; otherwise the `qdb-comic` shim is invoked to render it (the shim owns all the Spittoon / `.avb`-avatar knowledge), the result is cached, and then streamed. All the failure branches emit a gophermap type-3 row --- which is only safe because they all run *before* any PNG byte is written. The shim's stdout is redirected to `/dev/null` so a stray `puts` in the shim can never corrupt the image stream. > emitQuoteComic :: Ctx -> T.Text -> IO () > emitQuoteComic ctx i > | not (validId i) = > runMenu (emitPathError ctx ("/q/" <> i <> "/comic")) > | otherwise = do > let txt = quotePath i > png = comicPath i > haveTxt <- doesFileExist txt > if not haveTxt > then runMenu (emitNotFound ctx i) > else do > havePng <- doesFileExist png > rendered <- if havePng then pure True else renderComic txt png > okPng <- if rendered then doesFileExist png else pure False > if okPng > then BS.readFile png >>= BS.hPut stdout > else runMenu (emitComicError ctx i) > > -- | Invoke the `qdb-comic` shim as `qdb-comic `. Returns > -- 'True' on a clean exit. The shim's stdout goes to /dev/null; its > -- stderr is inherited so render failures land in Venusia's log. > renderComic :: FilePath -> FilePath -> IO Bool > renderComic txt png = do > result <- try go :: IO (Either SomeException ExitCode) > pure $ case result of > Right ExitSuccess -> True > _ -> False > where > go = withFile "/dev/null" WriteMode $ \devnull -> do > (_, _, _, ph) <- createProcess > (proc comicCmd [txt, png]) { std_out = UseHandle devnull } > waitForProcess ph Error pages ----------- > emitNotFound :: Ctx -> T.Text -> IO () > emitNotFound ctx i = mapM_ putLine > [ errorItem ("No quote #" <> i) > , menuLine "Back to qdb" (ctxScriptSel ctx) (ctxHost ctx) (ctxPort ctx) > , terminator > ] > > emitComicError :: Ctx -> T.Text -> IO () > emitComicError ctx i = mapM_ putLine > [ errorItem ("Could not render the Comic Chat strip for #" <> i > <> " --- is the qdb-comic shim (Spittoon) installed?") > , menuLine "Back to qdb" (ctxScriptSel ctx) (ctxHost ctx) (ctxPort ctx) > , terminator > ] > > emitPathError :: Ctx -> T.Text -> IO () > emitPathError ctx pinfo = mapM_ putLine > [ errorItem ("Unrecognised path-info: " <> pinfo) > , menuLine "Back to qdb" (ctxScriptSel ctx) (ctxHost ctx) (ctxPort ctx) > , terminator > ] Self-link helpers ----------------- `link` builds a path-info'd selector under this script's mount point. `quotesSel` is the file-server selector for the `quotes/` sibling directory --- raw `.txt` and cached `.comic.png` files are served from there by Venusia's own `[[files]]` block. `gopherUrl` renders a full `gopher://...` URL for the bookmarkable permalink. > link :: Ctx -> T.Text -> T.Text > link ctx sub = ctxScriptSel ctx <> sub > > quotesSel :: Ctx -> T.Text > quotesSel ctx = T.dropWhileEnd (/= '/') (ctxScriptSel ctx) <> "quotes" > > -- | >>> gopherUrl (Ctx "/applets/qdb/qdbviewer.lhs" "host" "70") '1' "/q/0007" > -- "gopher://host/1/applets/qdb/qdbviewer.lhs/q/0007" > -- > -- >>> gopherUrl (Ctx "/applets/qdb/qdbviewer.lhs" "host" "7070") '1' "/q/0007" > -- "gopher://host:7070/1/applets/qdb/qdbviewer.lhs/q/0007" > gopherUrl :: Ctx -> Char -> T.Text -> T.Text > gopherUrl ctx t sub = > let portPart = if ctxPort ctx == "70" then "" else ":" <> ctxPort ctx > in "gopher://" <> ctxHost ctx <> portPart > <> "/" <> T.singleton t <> ctxScriptSel ctx <> sub Gophermap line builders ----------------------- Same conventions as the other applets in this tree. Every row ends with `\r\n` (added by 'putLine'); every display field passes through 'sanitize' so a stray tab/newline can't smuggle an extra row. > putLine :: T.Text -> IO () > putLine t = TIO.putStr (t <> "\r\n") > > -- | >>> infoLine "hello" > -- "ihello\tnull\terror.host\t1" > infoLine :: T.Text -> T.Text > infoLine msg = "i" <> sanitize msg <> "\tnull\terror.host\t1" > > -- | >>> errorItem "nope" > -- "3nope\tnull\terror.host\t1" > errorItem :: T.Text -> T.Text > errorItem msg = "3" <> sanitize msg <> "\tnull\terror.host\t1" > > -- | >>> menuLine "home" "/" "host" "70" > -- "1home\t/\thost\t70" > menuLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text > menuLine display sel host port = > "1" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port > > -- | >>> textLine "doc" "/d" "host" "70" > -- "0doc\t/d\thost\t70" > textLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text > textLine display sel host port = > "0" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port > > -- | A type-I image row. > -- > -- >>> imageLine "strip" "/q/1/comic" "host" "70" > -- "Istrip\t/q/1/comic\thost\t70" > imageLine :: T.Text -> T.Text -> T.Text -> T.Text -> T.Text > imageLine display sel host port = > "I" <> sanitize display <> "\t" <> sel <> "\t" <> host <> "\t" <> port > > terminator :: T.Text > terminator = "." Small text helpers ------------------ > -- | >>> sanitize "ok" > -- "ok" > -- > -- >>> sanitize "with\ttab" > -- "with tab" > -- > -- >>> sanitize "line\nbreak" > -- "line break" > sanitize :: T.Text -> T.Text > sanitize = T.map (\c -> if c == '\r' || c == '\n' || c == '\t' then ' ' else c) > > -- | >>> truncateText 5 "hello" > -- "hello" > -- > -- >>> truncateText 8 "hello world" > -- "hello..." > -- > -- >>> truncateText 2 "hello" > -- "..." > truncateText :: Int -> T.Text -> T.Text > truncateText n t > | T.length t <= n = t > | otherwise = T.take (max 0 (n - 3)) t <> "..." > > -- | First non-blank transcript line, trimmed; a placeholder if none. > -- > -- >>> firstBodyLine (Quote "1" "" "" "" "" "" ["", " ", "12:00 hey", "x"]) > -- "12:00 hey" > -- > -- >>> firstBodyLine (Quote "1" "" "" "" "" "" []) > -- "(empty)" > firstBodyLine :: Quote -> T.Text > firstBodyLine q = case filter (not . T.null . T.strip) (qBody q) of > (l:_) -> T.strip l > [] -> "(empty)" > > -- | >>> orUnknown "" > -- "?" > -- > -- >>> orUnknown " " > -- "?" > -- > -- >>> orUnknown "alice" > -- "alice" > orUnknown :: T.Text -> T.Text > orUnknown t = if T.null (T.strip t) then "?" else t > > tshow :: Show a => a -> T.Text > tshow = T.pack . show