{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

-- | STM callback bus over a global JSONL log.
--
-- The live log image is held in a 'TVar'; subscribers block via STM 'retry'
-- until posts matching their names appear. A background thread persists new
-- posts to a single @log.jsonl@ file under a file lock, so the lock never
-- appears in the agent path.
--
-- This is the in-process / single-runtime form of the bus. An out-of-process
-- form can replace the 'TVar' with file-change events without changing the
-- 'Post'/'Stamped'/'Log' image.
--
-- Polymorphic in the body type @a@. File persistence uses 'PostBody' for
-- JSON encoding/decoding at the storage boundary.
module Free.Agent.Bus
  ( -- * Bus handle
    Bus,
    busLogPath,
    openBus,
    closeBus,
    withBus,

    -- * Scribe
    scribe,
    scribeIO,
    postLocal,

    -- * Durable append
    appendStoredPosts,
    appendStoredPostsUnlocked,

    -- * Subscription
    readSince,
    awaitSince,

    -- * Agent runtime
    runSeatBus,
  )
where

import Circuit (close, companion, conjoint)
import Circuit.Agent (Name, Post (..), PostId, deliversTo, mkPost, sortNub)
import Circuit.Agent.Framing
  ( Log (..),
    PostBody,
    Snoc (..),
    Stamped,
    Uncons (..),
    encodeLog,
    frameStored,
    readLogFile,
    stamp,
    stamped,
    pattern Stamped,
  )
import Circuit.Agent.Mark (Mark (..), isEscalate, isHalt, markGlyph, markOf)
import Circuit.Agent.Tensor (closeShardIO)
import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Concurrent.STM
  ( STM,
    TMVar,
    TQueue,
    TVar,
    atomically,
    isEmptyTQueue,
    newEmptyTMVar,
    newTQueueIO,
    newTVarIO,
    putTMVar,
    readTQueue,
    readTVar,
    retry,
    takeTMVar,
    writeTQueue,
    writeTVar,
  )
import Control.Exception (SomeException, bracket, displayException, try)
import Control.Monad (forever, unless)
import Data.ByteString qualified as BS
import Data.Foldable (traverse_)
import Data.List (maximum)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Data.Time (UTCTime, getCurrentTime)
import Free.Agent.Seat (FreeSeat, interpretSeat)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FileLock (SharedExclusive (Exclusive), withFileLock)
import System.FilePath (takeDirectory, (<.>), (</>))
import System.IO (IOMode (AppendMode), withFile)
import Text.Printf (printf)

-- | Live bus handle, polymorphic in the post body type.
data Bus a = Bus
  { -- | In-memory log image, oldest first.
    forall a. Bus a -> TVar (Log a)
busLog :: TVar (Log a),
    -- | Posts waiting to be persisted, each paired with an acknowledgement
    -- 'TMVar' that is filled once the post is on disk.
    forall a. Bus a -> TQueue (Stamped a, TMVar ())
busPending :: TQueue (Stamped a, TMVar ()),
    -- | Path to @log.jsonl@.
    forall a. Bus a -> FilePath
busPath :: FilePath,
    -- | Background persistence thread.
    forall a. Bus a -> ThreadId
busThread :: ThreadId
  }

-- | Path to the underlying @log.jsonl@.
busLogPath :: Bus a -> FilePath
busLogPath :: forall a. Bus a -> FilePath
busLogPath = Bus a -> FilePath
forall a. Bus a -> FilePath
busPath

-- | Open or create a bus at the given root directory.
--
-- Loads any existing @log.jsonl@ into memory and starts the persistence
-- thread. The lock file lives at @root/log.jsonl.lock@.
openBus :: (PostBody a) => FilePath -> IO (Bus a)
openBus :: forall a. PostBody a => FilePath -> IO (Bus a)
openBus FilePath
root = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
root
  let path :: FilePath
path = FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
"log.jsonl"
  exists <- FilePath -> IO Bool
doesFileExist FilePath
path
  unless exists $ do
    -- Create an empty log file so out-of-process tailers have something to
    -- watch before the first post arrives.
    withFile path AppendMode (\Handle
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  initial <- if exists then readLogFile path else pure (Log [])
  tv <- newTVarIO initial
  q <- newTQueueIO
  tid <- forkIO (persistLoop path q)
  pure (Bus tv q path tid)

-- | Stop the persistence thread.
--
-- Does not flush pending posts; call this only when durability is not
-- required or after ensuring the log is quiescent.
closeBus :: Bus a -> IO ()
closeBus :: forall a. Bus a -> IO ()
closeBus = ThreadId -> IO ()
killThread (ThreadId -> IO ()) -> (Bus a -> ThreadId) -> Bus a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bus a -> ThreadId
forall a. Bus a -> ThreadId
busThread

-- | Bracketed 'openBus'/'closeBus': open a bus, run the action, kill the
-- persistence thread on exit. The seat loop holds one bus for its whole
-- lifetime and scribes replies in-process — no external scribe executable.
withBus :: (PostBody a) => FilePath -> (Bus a -> IO b) -> IO b
withBus :: forall a b. PostBody a => FilePath -> (Bus a -> IO b) -> IO b
withBus FilePath
root = IO (Bus a) -> (Bus a -> IO ()) -> (Bus a -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (FilePath -> IO (Bus a)
forall a. PostBody a => FilePath -> IO (Bus a)
openBus FilePath
root) Bus a -> IO ()
forall a. Bus a -> IO ()
closeBus

-- | Append a bare post to the live log inside one STM transaction.
--
-- The returned 'Stamped a' carries the absolute line id assigned by the
-- scribe. The caller must supply the timestamp. The returned 'TMVar' is
-- filled once the post has been persisted to disk.
scribe :: Bus a -> UTCTime -> Post a -> STM (Stamped a, TMVar ())
scribe :: forall a. Bus a -> UTCTime -> Post a -> STM (Stamped a, TMVar ())
scribe Bus a
bus UTCTime
ts Post a
p = do
  log0 <- TVar (Log a) -> STM (Log a)
forall a. TVar a -> STM a
readTVar (Bus a -> TVar (Log a)
forall a. Bus a -> TVar (Log a)
busLog Bus a
bus)
  let pid = Int -> PostId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Stamped a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Log a -> [Stamped a]
forall a. Log a -> [Stamped a]
unLog Log a
log0))
      stored = (UTCTime, PostId) -> Post a -> Stamped a
forall a. (UTCTime, PostId) -> Post a -> Stamped a
Stamped (UTCTime
ts, PostId
pid) Post a
p
  ack <- newEmptyTMVar
  writeTVar (busLog bus) (snoc log0 stored)
  writeTQueue (busPending bus) (stored, ack)
  pure (stored, ack)

-- | Synchronous scribe: assign the current timestamp, append, and wait for
-- the post to be persisted.
scribeIO :: Bus a -> Post a -> IO (Stamped a)
scribeIO :: forall a. Bus a -> Post a -> IO (Stamped a)
scribeIO Bus a
bus Post a
p = do
  ts <- IO UTCTime
getCurrentTime
  (stored, ack) <- atomically (scribe bus ts p)
  atomically (takeTMVar ack)
  pure stored

-- | File-truth scribe: assign the id from the file itself, under the lock.
--
-- The id is the current line count, read and appended under the exclusive
-- file lock, so concurrent processes can never assign the same id twice.
-- This is the posting path for anything that shares the log with other
-- processes (CLI posts, seat replies). The 'TVar' bus ('scribeIO') is for
-- a single runtime that owns all writes; a long-lived seat's in-memory
-- image goes stale the moment another process posts, and stale images
-- assign colliding ids.
postLocal :: (PostBody a) => FilePath -> Post a -> IO (Stamped a)
postLocal :: forall a. PostBody a => FilePath -> Post a -> IO (Stamped a)
postLocal FilePath
root Post a
p = do
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
root
  let path :: FilePath
path = FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
"log.jsonl"
  exists <- FilePath -> IO Bool
doesFileExist FilePath
path
  unless exists $ withFile path AppendMode (\Handle
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  ts <- getCurrentTime
  stored <- withFileLock (path <.> "lock") Exclusive $ \FileLock
_lock -> do
    n <- Word8 -> ByteString -> Int
BS.count Word8
0x0A (ByteString -> Int) -> IO ByteString -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
path
    let stored = (UTCTime, PostId) -> Post a -> Stamped a
forall a. (UTCTime, PostId) -> Post a -> Stamped a
Stamped (UTCTime
ts, Int -> PostId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Post a
p
    appendStoredPostsUnlocked path [stored]
    pure stored
  writePings path [stored]
  pure stored

-- | Append stamped posts under the exclusive file lock.
--
-- Shared durable image primitive for the live bus persistence loop. Does not
-- assign ids or timestamps.
appendStoredPosts :: (PostBody a) => FilePath -> [Stamped a] -> IO ()
appendStoredPosts :: forall a. PostBody a => FilePath -> [Stamped a] -> IO ()
appendStoredPosts FilePath
path [Stamped a]
posts =
  FilePath -> SharedExclusive -> (FileLock -> IO ()) -> IO ()
forall a. FilePath -> SharedExclusive -> (FileLock -> IO a) -> IO a
withFileLock (FilePath
path FilePath -> FilePath -> FilePath
<.> FilePath
"lock") SharedExclusive
Exclusive ((FileLock -> IO ()) -> IO ()) -> (FileLock -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \FileLock
_lock ->
    FilePath -> [Stamped a] -> IO ()
forall a. PostBody a => FilePath -> [Stamped a] -> IO ()
appendStoredPostsUnlocked FilePath
path [Stamped a]
posts

-- | Append stamped posts without taking the lock. Caller must already hold
-- @path.lock@ (or otherwise guarantee exclusive writers).
appendStoredPostsUnlocked :: (PostBody a) => FilePath -> [Stamped a] -> IO ()
appendStoredPostsUnlocked :: forall a. PostBody a => FilePath -> [Stamped a] -> IO ()
appendStoredPostsUnlocked FilePath
path [Stamped a]
posts =
  FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
AppendMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
    (Stamped a -> IO ()) -> [Stamped a] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> Text -> IO ()
TIO.hPutStrLn Handle
h (Text -> IO ()) -> (Stamped a -> Text) -> Stamped a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped a -> Text
forall a. PostBody a => Stamped a -> Text
frameStored) [Stamped a]
posts

-- | Read all posts matching any of the names with id at or after the cursor.
--
-- The cursor is the next unprocessed id, matching the file-cursor
-- convention. Does not retry; returns an empty list if nothing matches.
readSince :: Bus a -> [Name] -> PostId -> STM [Stamped a]
readSince :: forall a. Bus a -> [Text] -> PostId -> STM [Stamped a]
readSince Bus a
bus [Text]
names PostId
since = do
  log0 <- TVar (Log a) -> STM (Log a)
forall a. TVar a -> STM a
readTVar (Bus a -> TVar (Log a)
forall a. Bus a -> TVar (Log a)
busLog Bus a
bus)
  let posts = Log a -> [Stamped a]
forall a. Log a -> [Stamped a]
unLog Log a
log0
  pure [s | s <- posts, snd (stamp s) >= since, deliversTo (stamped s) names]

-- | Wait until at least one matching post exists after the cursor.
awaitSince :: Bus a -> [Name] -> PostId -> STM [Stamped a]
awaitSince :: forall a. Bus a -> [Text] -> PostId -> STM [Stamped a]
awaitSince Bus a
bus [Text]
names PostId
since = do
  found <- Bus a -> [Text] -> PostId -> STM [Stamped a]
forall a. Bus a -> [Text] -> PostId -> STM [Stamped a]
readSince Bus a
bus [Text]
names PostId
since
  if null found then retry else pure found

-- | Run a 'FreeSeat' as a bus agent.
--
-- Blocks via 'awaitSince' (STM retry) for posts addressed to any of the
-- names, feeds the batch into the seat, and scribes any emitted replies.
-- This is the callback loop: no polling, no file locks in the agent path.
--
-- Replies carry thread edges citing the parent 'stamp'. To preserve the
-- input-to-output mapping we process one 'Stamped Text' at a time; the seat
-- still sees a singleton batch, and the parent id is prepended to each
-- emitted post's 'thread'.
--
-- Decided quiet: a delivered post carrying a halt (🟢 / 🔵) or escalation
-- (🔴) mark stops the loop. Marks are control, not content: they are not
-- handed to the seat.
--
-- Self-halt: a 🔵 reply is the seat deciding its own quiet — scribe it and
-- stop, mid-batch if need be; later posts go unanswered (the seat is gone).
-- 🟢 stays exchange-level: a seat may land one exchange and host more.
runSeatBus :: Bus Text -> Name -> [Name] -> FreeSeat -> IO ()
runSeatBus :: Bus Text -> Text -> [Text] -> FreeSeat -> IO ()
runSeatBus Bus Text
bus Text
agentName [Text]
names FreeSeat
seat = PostId -> IO ()
loop PostId
0
  where
    sh :: AgentShard [Post Text] [Post Text]
sh = FreeSeat -> AgentShard [Post Text] [Post Text]
interpretSeat FreeSeat
seat
    loop :: PostId -> IO ()
loop PostId
lastId = do
      posts <- STM [Stamped Text] -> IO [Stamped Text]
forall a. STM a -> IO a
atomically (Bus Text -> [Text] -> PostId -> STM [Stamped Text]
forall a. Bus a -> [Text] -> PostId -> STM [Stamped a]
awaitSince Bus Text
bus [Text]
names PostId
lastId)
      let marked = (Stamped Text -> Bool) -> [Stamped Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Post Text -> Bool
halts (Post Text -> Bool)
-> (Stamped Text -> Post Text) -> Stamped Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped) [Stamped Text]
posts
          work = (Stamped Text -> Bool) -> [Stamped Text] -> [Stamped Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Stamped Text -> Bool) -> Stamped Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Post Text -> Bool
halts (Post Text -> Bool)
-> (Stamped Text -> Post Text) -> Stamped Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped) [Stamped Text]
posts
      selfHalt <- go work
      unless (marked || selfHalt) $
        loop (maximum (map (snd . stamp) posts) + 1)
    go :: [Stamped Text] -> IO Bool
go [] = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    go (Stamped Text
stored : [Stamped Text]
rest) = do
      outs <- Stamped Text -> IO [Post Text]
processOne Stamped Text
stored
      let keep Post Text
p =
            let b :: Text
b = Text -> Text
T.strip (Post Text -> Text
forall a. Post a -> a
body Post Text
p)
             in Bool -> Bool
not (Text -> Bool
T.null Text
b) Bool -> Bool -> Bool
&& Text
b Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"(empty)"
          nonEmpty = (Post Text -> Bool) -> [Post Text] -> [Post Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Post Text -> Bool
keep [Post Text]
outs
      traverse_ (scribeIO bus) nonEmpty
      if any ((== Just StandDown) . markOf) outs
        then pure True
        else go rest
    halts :: Post Text -> Bool
halts Post Text
p = Bool -> (Mark -> Bool) -> Maybe Mark -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Mark
m -> Mark -> Bool
isHalt Mark
m Bool -> Bool -> Bool
|| Mark -> Bool
isEscalate Mark
m) (Post Text -> Maybe Mark
markOf Post Text
p)
    processOne :: Stamped Text -> IO [Post Text]
processOne Stamped Text
stored = do
      er <-
        forall e a. Exception e => IO a -> IO (Either e a)
try @SomeException (IO [Post Text] -> IO (Either SomeException [Post Text]))
-> IO [Post Text] -> IO (Either SomeException [Post Text])
forall a b. (a -> b) -> a -> b
$ do
          let p :: Post Text
p = Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
stored
              parentId :: PostId
parentId = (UTCTime, PostId) -> PostId
forall a b. (a, b) -> b
snd (Stamped Text -> (UTCTime, PostId)
forall r a. Stamped r a -> r
stamp Stamped Text
stored)
          (outs, _st) <- AgentShard [Post Text] [Post Text]
-> [Post Text] -> [Post Text] -> IO ([Post Text], [Post Text])
forall s a. Poles (Body (,) s (K IO)) a a -> a -> s -> IO (a, s)
closeShardIO AgentShard [Post Text] [Post Text]
sh [Post Text
p] []
          pure [out {thread = sortNub (parentId : thread out)} | out <- outs]
      case er of
        Left SomeException
e -> do
          let p :: Post Text
p = Stamped Text -> Post Text
forall r a. Stamped r a -> a
stamped Stamped Text
stored
              exc :: Text
exc = FilePath -> Text
T.pack (SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
e)
              msg :: Text
msg = Mark -> Text
markGlyph Mark
Escalate Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" handler failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
exc
          _ <- Bus Text -> Post Text -> IO (Stamped Text)
forall a. Bus a -> Post a -> IO (Stamped a)
scribeIO Bus Text
bus (Text -> [Text] -> Text -> Post Text
forall a. Text -> [Text] -> a -> Post a
mkPost Text
agentName [Post Text -> Text
forall a. Post a -> Text
from Post Text
p] Text
msg)
          pure []
        Right [Post Text]
outs -> [Post Text] -> IO [Post Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Post Text]
outs

-- ---------------------------------------------------------------------------
-- Internal helpers
-- ---------------------------------------------------------------------------

-- | Background persistence loop.
--
-- Batches all posts currently in the queue, appends them under a file lock,
-- writes per-agent ping files, then repeats. Empty queue blocks via
-- 'readTQueue'.
persistLoop :: (PostBody a) => FilePath -> TQueue (Stamped a, TMVar ()) -> IO ()
persistLoop :: forall a.
PostBody a =>
FilePath -> TQueue (Stamped a, TMVar ()) -> IO ()
persistLoop FilePath
path TQueue (Stamped a, TMVar ())
q = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  pairs <- STM [(Stamped a, TMVar ())] -> IO [(Stamped a, TMVar ())]
forall a. STM a -> IO a
atomically (STM [(Stamped a, TMVar ())] -> IO [(Stamped a, TMVar ())])
-> STM [(Stamped a, TMVar ())] -> IO [(Stamped a, TMVar ())]
forall a b. (a -> b) -> a -> b
$ do
    first <- TQueue (Stamped a, TMVar ()) -> STM (Stamped a, TMVar ())
forall a. TQueue a -> STM a
readTQueue TQueue (Stamped a, TMVar ())
q
    rest <- drainQueue
    pure (first : rest)
  let posts = ((Stamped a, TMVar ()) -> Stamped a)
-> [(Stamped a, TMVar ())] -> [Stamped a]
forall a b. (a -> b) -> [a] -> [b]
map (Stamped a, TMVar ()) -> Stamped a
forall a b. (a, b) -> a
fst [(Stamped a, TMVar ())]
pairs
  appendStoredPosts path posts
  writePings path posts
  atomically $ traverse_ (\(Stamped a
_, TMVar ()
ack) -> TMVar () -> () -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
ack ()) pairs
  where
    drainQueue :: STM [(Stamped a, TMVar ())]
drainQueue = do
      empty <- TQueue (Stamped a, TMVar ()) -> STM Bool
forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue (Stamped a, TMVar ())
q
      if empty
        then pure []
        else do
          x <- readTQueue q
          xs <- drainQueue
          pure (x : xs)

-- | Write a @.ping-NAME@ file for each named recipient of each post.
--
-- The file contains the latest post id addressed to that recipient. Agents can
-- watch this file cheaply instead of re-parsing the log on every wake.
writePings :: FilePath -> [Stamped a] -> IO ()
writePings :: forall a. FilePath -> [Stamped a] -> IO ()
writePings FilePath
path [Stamped a]
posts = ((Text, PostId) -> IO ()) -> [(Text, PostId)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text, PostId) -> IO ()
writeOne [(Text, PostId)]
recipients
  where
    root :: FilePath
root = FilePath -> FilePath
takeDirectory FilePath
path
    pingFile :: Text -> FilePath
pingFile Text
name = FilePath
root FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
".ping-%s" (Text -> FilePath
T.unpack Text
name)
    recipients :: [(Text, PostId)]
recipients = (Stamped a -> [(Text, PostId)]) -> [Stamped a] -> [(Text, PostId)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Stamped a -> [(Text, PostId)]
forall {a} {b} {a}. Stamped (a, b) (Post a) -> [(Text, b)]
postRecipients [Stamped a]
posts
    postRecipients :: Stamped (a, b) (Post a) -> [(Text, b)]
postRecipients Stamped (a, b) (Post a)
stored =
      case Post a -> [Text]
forall a. Post a -> [Text]
to (Stamped (a, b) (Post a) -> Post a
forall r a. Stamped r a -> a
stamped Stamped (a, b) (Post a)
stored) of
        [] -> []
        [Text
""] -> []
        [Text]
ts -> [(Text
name, (a, b) -> b
forall a b. (a, b) -> b
snd (Stamped (a, b) (Post a) -> (a, b)
forall r a. Stamped r a -> r
stamp Stamped (a, b) (Post a)
stored)) | Text
name <- [Text]
ts]
    writeOne :: (Text, PostId) -> IO ()
writeOne (Text
name, PostId
pid) =
      FilePath -> Text -> IO ()
TIO.writeFile (Text -> FilePath
pingFile Text
name) (FilePath -> Text
T.pack (PostId -> FilePath
forall a. Show a => a -> FilePath
show PostId
pid))