commit f9b7765043dfc6f1942f1c2dbbd317ab91eccf72
Author: Coder Agent <coder@agents.omni>
Date: Mon Feb 16 12:50:37 2026
Omni/Serve: markdown file server for ~/ava
Lightweight warp-based file server that serves a directory over HTTP,
rendering .md files as readable HTML with clean styling and providing
directory listings for browsing. Supports dark mode, file icons, and
breadcrumb navigation.
Task-Id: t-606
diff --git a/Omni/Serve.hs b/Omni/Serve.hs
new file mode 100755
index 00000000..9337176b
--- /dev/null
+++ b/Omni/Serve.hs
@@ -0,0 +1,329 @@
+#!/usr/bin/env run.sh
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Lightweight file server with markdown rendering.
+--
+-- Serves a directory over HTTP, rendering .md files as readable HTML
+-- and providing directory listings for browsing.
+--
+-- Usage:
+-- serve # Serve ~/ava on port 8070
+-- serve --root /some/dir # Serve a different directory
+-- serve --port 9000 # Custom port
+--
+-- : out serve
+-- : dep cmark
+-- : dep lucid
+-- : dep wai
+-- : dep wai-extra
+-- : dep warp
+-- : dep filepath
+-- : dep directory
+-- : dep bytestring
+-- : dep text
+-- : dep http-types
+-- : dep time
+module Omni.Serve
+ ( main,
+ test,
+ )
+where
+
+import Alpha
+import qualified CMark
+import qualified Data.List as List
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Data.Text.IO as TIO
+import qualified Data.Time as Time
+import qualified Data.Time.Format as TimeF
+import qualified Lucid as L
+import qualified Network.HTTP.Types as HTTP
+import qualified Network.HTTP.Types.Header as Header
+import qualified Network.Wai as Wai
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Omni.Cli as Cli
+import qualified Omni.Test as Test
+import qualified System.Directory as Dir
+import qualified System.FilePath as FP
+
+main :: IO ()
+main = Cli.main plan
+
+plan :: Cli.Plan ()
+plan =
+ Cli.Plan
+ { Cli.move = parser,
+ Cli.test = test,
+ Cli.tidy = \_ -> pure ()
+ }
+
+parser :: Cli.Parser (IO ())
+parser =
+ run
+ </ Cli.strOption
+ ( Cli.long "root"
+ <> Cli.value "/home/ben/ava"
+ <> Cli.help "Directory to serve"
+ )
+ <*> Cli.option
+ Cli.auto
+ ( Cli.long "port"
+ <> Cli.value (8070 :: Int)
+ <> Cli.help "Port to listen on"
+ )
+
+run :: FilePath -> Int -> IO ()
+run root port = do
+ putStrLn <| "Serving " <> root <> " on port " <> show port
+ Warp.run port (app root)
+
+-- | Main WAI application.
+app :: FilePath -> Wai.Application
+app root req respond = do
+ let rawPath = TE.decodeUtf8 (Wai.rawPathInfo req)
+ relPath = T.unpack (normalizePath rawPath)
+ fullPath = root FP.</> relPath
+
+ exists <- Dir.doesPathExist fullPath
+ if not exists
+ then respond <| htmlResponse HTTP.status404 (errorPage "404 — Not Found" ("No such file: " <> rawPath))
+ else do
+ isDir <- Dir.doesDirectoryExist fullPath
+ if isDir
+ then do
+ listing <- dirListing root relPath
+ respond <| htmlResponse HTTP.status200 listing
+ else serveFile fullPath rawPath respond
+
+-- | Serve a single file, rendering markdown as HTML.
+serveFile :: FilePath -> Text -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived
+serveFile fullPath _rawPath respond
+ | isMarkdown fullPath = do
+ content <- TIO.readFile fullPath
+ let html = renderMarkdown (FP.takeFileName fullPath) content
+ respond <| htmlResponse HTTP.status200 html
+ | otherwise = do
+ let mime = guessMime fullPath
+ respond <| Wai.responseFile HTTP.status200 [(Header.hContentType, mime)] fullPath Nothing
+
+-- | Render markdown to a full HTML page.
+renderMarkdown :: FilePath -> Text -> L.Html ()
+renderMarkdown filename content = do
+ let title = T.pack (FP.dropExtension filename)
+ rendered = CMark.commonmarkToHtml [CMark.optSmart, CMark.optUnsafe] content
+ pageShell title <| do
+ L.div_ [L.class_ "breadcrumb"] <| do
+ L.a_ [L.href_ "/"] "home"
+ L.article_ [L.class_ "markdown-body"]
+ <| L.toHtmlRaw rendered
+
+-- | Directory listing page.
+dirListing :: FilePath -> FilePath -> IO (L.Html ())
+dirListing root relPath = do
+ let fullPath = root FP.</> relPath
+ title = if relPath == "" || relPath == "." then "/" else T.pack ("/" <> relPath)
+ entries <- Dir.listDirectory fullPath
+ items <-
+ forM (List.sort entries) <| \name -> do
+ let entryPath = fullPath FP.</> name
+ isDir <- Dir.doesDirectoryExist entryPath
+ modTime <- Dir.getModificationTime entryPath
+ size <-
+ if isDir
+ then pure Nothing
+ else Just </ Dir.getFileSize entryPath
+ pure (name, isDir, modTime, size)
+ pure <| pageShell title <| do
+ L.div_ [L.class_ "breadcrumb"] <| breadcrumbs relPath
+ L.h1_ (L.toHtml title)
+ L.table_ [L.class_ "listing"] <| do
+ L.thead_ <| L.tr_ <| do
+ L.th_ "Name"
+ L.th_ [L.class_ "size"] "Size"
+ L.th_ [L.class_ "modified"] "Modified"
+ L.tbody_ <| do
+ -- Parent directory link
+ when (relPath /= "" && relPath /= ".")
+ <| L.tr_
+ <| do
+ L.td_ <| L.a_ [L.href_ (T.pack ("/" <> FP.takeDirectory relPath))] "⬆ .."
+ L.td_ ""
+ L.td_ ""
+ forM_ items <| \(name, isDir, modTime, size) -> do
+ let href = T.pack ("/" <> relPath FP.</> name <> if isDir then "/" else "")
+ icon = if isDir then "📁 " else fileIcon name
+ L.tr_ <| do
+ L.td_ <| do
+ L.a_ [L.href_ href] <| L.toHtml (icon <> T.pack name)
+ L.td_ [L.class_ "size"] <| L.toHtml (maybe "" formatSize size)
+ L.td_ [L.class_ "modified"] <| L.toHtml (formatTime modTime)
+
+-- | Breadcrumb navigation.
+breadcrumbs :: FilePath -> L.Html ()
+breadcrumbs relPath = do
+ L.a_ [L.href_ "/"] "home"
+ forM_ (zip [1 ..] parts) <| \(i, part) -> do
+ L.toHtml (" / " :: Text)
+ let href = T.pack ("/" <> FP.joinPath (take i parts))
+ L.a_ [L.href_ href] (L.toHtml (T.pack part))
+ where
+ parts = filter (/= ".") (FP.splitDirectories relPath)
+
+-- | Common page shell with CSS.
+pageShell :: Text -> L.Html () -> L.Html ()
+pageShell title body =
+ L.doctypehtml_ <| do
+ L.head_ <| do
+ L.meta_ [L.charset_ "utf-8"]
+ L.meta_ [L.name_ "viewport", L.content_ "width=device-width, initial-scale=1"]
+ L.title_ (L.toHtml title)
+ L.style_ css
+ L.body_ body
+
+-- | Stylesheet.
+css :: Text
+css =
+ T.unlines
+ [ ":root { --bg: #fff; --fg: #222; --muted: #666; --border: #e0e0e0;",
+ " --link: #0366d6; --code-bg: #f6f8fa; --hover: #f5f5f5; }",
+ "@media (prefers-color-scheme: dark) {",
+ " :root { --bg: #1a1a1a; --fg: #d4d4d4; --muted: #888; --border: #333;",
+ " --link: #58a6ff; --code-bg: #2d2d2d; --hover: #252525; }",
+ "}",
+ "* { box-sizing: border-box; }",
+ "body { font-family: -apple-system, system-ui, sans-serif;",
+ " max-width: 900px; margin: 0 auto; padding: 1rem 1.5rem;",
+ " background: var(--bg); color: var(--fg); line-height: 1.6; }",
+ "a { color: var(--link); text-decoration: none; }",
+ "a:hover { text-decoration: underline; }",
+ ".breadcrumb { font-size: 0.85rem; color: var(--muted); margin-bottom: 1rem; }",
+ "h1 { font-size: 1.5rem; margin: 0 0 1rem; }",
+ "",
+ "/* Directory listing */",
+ ".listing { width: 100%; border-collapse: collapse; }",
+ ".listing th { text-align: left; border-bottom: 2px solid var(--border);",
+ " padding: 0.4rem 0.8rem; font-size: 0.85rem; color: var(--muted); }",
+ ".listing td { padding: 0.4rem 0.8rem; border-bottom: 1px solid var(--border); }",
+ ".listing tr:hover { background: var(--hover); }",
+ ".listing .size, .listing .modified { text-align: right; ",
+ " font-size: 0.85rem; color: var(--muted); white-space: nowrap; }",
+ "",
+ "/* Markdown */",
+ ".markdown-body { font-size: 1rem; }",
+ ".markdown-body h1 { font-size: 1.8rem; border-bottom: 1px solid var(--border);",
+ " padding-bottom: 0.3rem; }",
+ ".markdown-body h2 { font-size: 1.4rem; border-bottom: 1px solid var(--border);",
+ " padding-bottom: 0.2rem; }",
+ ".markdown-body h3 { font-size: 1.15rem; }",
+ ".markdown-body pre { background: var(--code-bg); padding: 1rem;",
+ " border-radius: 6px; overflow-x: auto; font-size: 0.9rem; }",
+ ".markdown-body code { background: var(--code-bg); padding: 0.15rem 0.3rem;",
+ " border-radius: 3px; font-size: 0.9em; }",
+ ".markdown-body pre code { background: none; padding: 0; }",
+ ".markdown-body img { max-width: 100%; height: auto; }",
+ ".markdown-body table { border-collapse: collapse; width: 100%; }",
+ ".markdown-body th, .markdown-body td { border: 1px solid var(--border);",
+ " padding: 0.4rem 0.8rem; }",
+ ".markdown-body blockquote { border-left: 4px solid var(--border);",
+ " margin-left: 0; padding-left: 1rem; color: var(--muted); }"
+ ]
+
+-- ============================================================================
+-- Helpers
+-- ============================================================================
+
+-- | Normalize URL path: strip leading slash, prevent traversal.
+normalizePath :: Text -> Text
+normalizePath p =
+ let stripped = T.dropWhile (== '/') p
+ parts = filter (not <. T.null) (T.splitOn "/" stripped)
+ safe = filter (/= "..") parts
+ in T.intercalate "/" safe
+
+isMarkdown :: FilePath -> Bool
+isMarkdown path = FP.takeExtension path `elem` [".md", ".markdown"]
+
+fileIcon :: String -> Text
+fileIcon name = case FP.takeExtension name of
+ ".md" -> "📄 "
+ ".markdown" -> "📄 "
+ ".py" -> "🐍 "
+ ".hs" -> "λ "
+ ".nix" -> "❄ "
+ ".json" -> "📋 "
+ ".csv" -> "📊 "
+ ".txt" -> "📝 "
+ ".png" -> "🖼 "
+ ".jpg" -> "🖼 "
+ ".jpeg" -> "🖼 "
+ ".gif" -> "🖼 "
+ ".svg" -> "🖼 "
+ ".pdf" -> "📕 "
+ _ -> "📎 "
+
+guessMime :: FilePath -> ByteString
+guessMime path = case FP.takeExtension path of
+ ".html" -> "text/html"
+ ".css" -> "text/css"
+ ".js" -> "application/javascript"
+ ".json" -> "application/json"
+ ".csv" -> "text/csv"
+ ".txt" -> "text/plain; charset=utf-8"
+ ".py" -> "text/plain; charset=utf-8"
+ ".hs" -> "text/plain; charset=utf-8"
+ ".nix" -> "text/plain; charset=utf-8"
+ ".md" -> "text/plain; charset=utf-8"
+ ".png" -> "image/png"
+ ".jpg" -> "image/jpeg"
+ ".jpeg" -> "image/jpeg"
+ ".gif" -> "image/gif"
+ ".svg" -> "image/svg+xml"
+ ".pdf" -> "application/pdf"
+ ".ico" -> "image/x-icon"
+ _ -> "application/octet-stream"
+
+formatSize :: Integer -> Text
+formatSize bytes
+ | bytes < 1024 = T.pack (show bytes) <> " B"
+ | bytes < 1024 * 1024 = T.pack (show (bytes `div` 1024)) <> " KB"
+ | otherwise = T.pack (show (bytes `div` (1024 * 1024))) <> " MB"
+
+formatTime :: Time.UTCTime -> Text
+formatTime = T.pack <. TimeF.formatTime TimeF.defaultTimeLocale "%Y-%m-%d %H:%M"
+
+errorPage :: Text -> Text -> L.Html ()
+errorPage title msg =
+ pageShell title <| do
+ L.h1_ (L.toHtml title)
+ L.p_ (L.toHtml msg)
+
+htmlResponse :: HTTP.Status -> L.Html () -> Wai.Response
+htmlResponse status html =
+ Wai.responseLBS
+ status
+ [(Header.hContentType, "text/html; charset=utf-8")]
+ (L.renderBS html)
+
+-- ============================================================================
+-- Tests
+-- ============================================================================
+
+test :: Test.Tree
+test =
+ Test.group
+ "Omni.Serve"
+ [ Test.unit "normalizePath strips leading slash" <| do
+ normalizePath "/foo/bar" Test.@=? "foo/bar",
+ Test.unit "normalizePath blocks traversal" <| do
+ normalizePath "/../etc/passwd" Test.@=? "etc/passwd",
+ Test.unit "normalizePath handles root" <| do
+ normalizePath "/" Test.@=? "",
+ Test.unit "isMarkdown detects .md" <| do
+ Test.assertBool ".md" (isMarkdown "foo.md")
+ Test.assertBool "not .txt" (not (isMarkdown "foo.txt")),
+ Test.unit "formatSize formats bytes" <| do
+ formatSize 500 Test.@=? "500 B"
+ formatSize 2048 Test.@=? "2 KB"
+ ]