{-# LANGUAGE OverloadedStrings #-}

-- | A position in an append-only log of lines.
--
-- Two storage backends, one type:
--
--   * 'newMem'  — 'IORef' (ephemeral; dies with the process)
--   * 'newFile' — file holding a decimal line count (survives restart)
--
-- Both answer the same question: /what is new since I last asked?/
--
-- This module has no dependency on muster or circuits-io. Either consumer
-- can hold a 'Cursor' and call 'pollLines' / 'pollFile' without caring
-- where the position lives.
--
-- === Line index convention
--
-- Positions are zero-based counts of complete lines (same as
-- @length (T.lines content)@ when every record ends in @\\n@, and same as
-- @wc -l@). 'pollLines' advances to @length xs@ after returning the suffix.
module Cursor
  ( Cursor,
    newMem,
    newFile,
    get,
    set,
    pollLines,
    pollFile,
    pollNumberedFile,
    seekEnd,
    seekEndFile,
    readLogLinesComplete,
  )
where

import Data.Char (isSpace)
import Data.IORef
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import System.Directory (doesFileExist)
import Text.Read (readMaybe)
import Prelude

-- | Opaque read position in a line-oriented log.
--
-- Construct with 'newMem' or 'newFile'. Read/write with 'get'/'set'.
-- Advance with 'pollLines' (in-memory log) or 'pollFile' (path to log).
data Cursor = Cursor
  { Cursor -> IO Int
cursorGet :: IO Int,
    Cursor -> Int -> IO ()
cursorSet :: Int -> IO ()
  }

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Cursor
-- >>> import Data.Text (Text)

-- | In-memory cursor (IORef). Position dies with the process.
--
-- >>> c <- newMem 0
-- >>> get c
-- 0
-- >>> pollLines c ["a", "b" :: Text]
-- ["a","b"]
-- >>> pollLines c ["a", "b", "c"]
-- ["c"]
-- >>> get c
-- 3
newMem :: Int -> IO Cursor
newMem :: Int -> IO Cursor
newMem Int
n0 = do
  ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
n0
  pure
    Cursor
      { cursorGet = readIORef ref,
        cursorSet = writeIORef ref
      }

-- | File-backed cursor. Contents are a decimal integer plus newline
-- (muster-compatible: @show n <> "\\n"@). Missing file reads as 0;
-- first 'set' creates it.
newFile :: FilePath -> IO Cursor
newFile :: String -> IO Cursor
newFile String
path =
  Cursor -> IO Cursor
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Cursor
      { cursorGet :: IO Int
cursorGet = String -> IO Int
readFilePos String
path,
        cursorSet :: Int -> IO ()
cursorSet = String -> Int -> IO ()
writeFilePos String
path
      }

-- | Current line position.
get :: Cursor -> IO Int
get :: Cursor -> IO Int
get = Cursor -> IO Int
cursorGet

-- | Set line position (does not touch the log).
set :: Cursor -> Int -> IO ()
set :: Cursor -> Int -> IO ()
set = Cursor -> Int -> IO ()
cursorSet

-- | Given the full current log as lines, return those after the cursor
-- and advance the cursor to @length xs@.
--
-- Idempotent on a frozen log: a second call with the same @xs@ yields @[]@.
--
-- If the cursor is past the end of the current content (for example because
-- the log was deleted or truncated), it resets to @0@ and the current content
-- is returned as new. This keeps cursors from becoming permanently stale.
--
-- >>> c <- newMem 0
-- >>> pollLines c ["x" :: Text]
-- ["x"]
-- >>> pollLines c ["x"]
-- []
pollLines :: Cursor -> [Text] -> IO [Text]
pollLines :: Cursor -> [Text] -> IO [Text]
pollLines Cursor
c [Text]
xs = do
  pos <- Cursor -> IO Int
cursorGet Cursor
c
  let total = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs
      pos' = if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
total then Int
0 else Int
pos
      news = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
pos' [Text]
xs
  cursorSet c total
  pure news

-- | Read a log file as lines ('T.lines'), then 'pollLines'.
--
-- Missing file → empty log. Empty file → empty log.
--
-- Partial last lines (no trailing newline) are kept as a final element of
-- 'T.lines' only when content is non-empty and does not end in @\\n@ —
-- actually 'T.lines' drops a trailing empty segment, so a file ending
-- without @\\n@ still yields its last partial line. Prompt-style partial
-- lines are therefore visible to the cursor; completeness is the caller's
-- concern (prompt detection lives above this layer).
pollFile :: Cursor -> FilePath -> IO [Text]
pollFile :: Cursor -> String -> IO [Text]
pollFile Cursor
c String
path = do
  ls <- String -> IO [Text]
readLogLines String
path
  pollLines c ls

-- | Like 'pollFile', but consumes only newline-terminated lines and
-- returns absolute 1-based line numbers alongside.
--
-- A partial trailing line (file not ending in @\\n@) is left unconsumed:
-- the cursor stays before it, so once completed the line is delivered
-- exactly once, on a later poll.  This is the completeness discipline
-- 'pollFile' leaves to the caller, made the default.  Truncation resets
-- to 0, same as 'pollLines'.
pollNumberedFile :: Cursor -> FilePath -> IO [(Int, Text)]
pollNumberedFile :: Cursor -> String -> IO [(Int, Text)]
pollNumberedFile Cursor
c String
path = do
  ls <- String -> IO [Text]
readLogLinesComplete String
path
  pos <- get c
  let total = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls
      pos' = if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
total then Int
0 else Int
pos
      news = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
pos' [Text]
ls
  set c total
  pure (zip [pos' + 1 ..] news)

-- | Move the cursor to the end of the given lines without returning them.
-- Attach pattern: start at "now" so the next poll only sees future output.
--
-- >>> c <- newMem 0
-- >>> seekEnd c ["old" :: Text, "history"]
-- >>> pollLines c ["old", "history", "new"]
-- ["new"]
seekEnd :: Cursor -> [Text] -> IO ()
seekEnd :: Cursor -> [Text] -> IO ()
seekEnd Cursor
c [Text]
xs = Cursor -> Int -> IO ()
cursorSet Cursor
c ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs)

-- | 'seekEnd' for a log path.
seekEndFile :: Cursor -> FilePath -> IO ()
seekEndFile :: Cursor -> String -> IO ()
seekEndFile Cursor
c String
path = do
  ls <- String -> IO [Text]
readLogLines String
path
  seekEnd c ls

-- ---------------------------------------------------------------------------
-- Internals
-- ---------------------------------------------------------------------------

readFilePos :: FilePath -> IO Int
readFilePos :: String -> IO Int
readFilePos String
path = do
  exists <- String -> IO Bool
doesFileExist String
path
  if not exists
    then pure 0
    else do
      -- Strict read: lazy 'readFile' holds the handle and locks subsequent writes.
      raw <- T.unpack <$> TIO.readFile path
      pure $ fromMaybe 0 $ readMaybe (filter (not . isSpace) raw)

writeFilePos :: FilePath -> Int -> IO ()
writeFilePos :: String -> Int -> IO ()
writeFilePos String
path Int
n = String -> Text -> IO ()
TIO.writeFile String
path (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"))

-- | Line split matching muster @T.lines@ / @wc -l@ for newline-terminated
-- records. Empty file → @[]@.
readLogLines :: FilePath -> IO [Text]
readLogLines :: String -> IO [Text]
readLogLines String
path = do
  exists <- String -> IO Bool
doesFileExist String
path
  if not exists
    then pure []
    else do
      content <- TIO.readFile path
      pure $ if T.null content then [] else T.lines content

-- | 'readLogLines' restricted to newline-terminated records: a partial
-- trailing line (content not ending in @\\n@) is excluded.
readLogLinesComplete :: FilePath -> IO [Text]
readLogLinesComplete :: String -> IO [Text]
readLogLinesComplete String
path = do
  exists <- String -> IO Bool
doesFileExist String
path
  if not exists
    then pure []
    else do
      content <- TIO.readFile path
      let ls = if Text -> Bool
T.null Text
content then [] else Text -> [Text]
T.lines Text
content
      pure $
        if T.isSuffixOf "\n" content
          then ls
          else take (length ls - 1) ls