packages feed

language-smtlib-0.1.0.0: src/Language/SMTLIB/Reader/Handle.hs

-- | Reading S-expressions and commands incrementally from a 'Handle' (a file, a
-- socket, or a pipe to a running solver).
--
-- A t'HandleReader' buffers any input read past the end of one frame, so the
-- next read resumes from it.  Crucially, it reads from the handle /only/ while a
-- frame is still incomplete: once a frame closes it returns immediately without
-- touching the handle, so it never blocks waiting for input beyond the command
-- it has already received.  Reads use 'T.hGetChunk', which returns whatever is
-- currently available rather than waiting to fill a buffer.
--
-- This module deliberately does not manage solver subprocesses; it provides the
-- reading primitive that such a driver builds on.
module Language.SMTLIB.Reader.Handle
  ( HandleReader
  , newHandleReader
  , readSExpr
  , readCommand
  ) where

import Data.IORef
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.IO (Handle)
import Text.Megaparsec (eof, errorBundlePretty, parse)

import Language.SMTLIB.Parser.Command (pCommand)
import Language.SMTLIB.Parser.Internal (sc)
import Language.SMTLIB.Parser.SExpr
import Language.SMTLIB.Syntax.Annotation (SrcSpan)
import Language.SMTLIB.Syntax.Command (Command)

-- | A handle paired with a buffer of input read past the previous frame.
data HandleReader = HandleReader
  { hrHandle   :: !Handle
  , hrLeftover :: !(IORef Text)
  }

-- | Create a reader over a handle.
newHandleReader :: Handle -> IO HandleReader
newHandleReader h = HandleReader h <$> newIORef T.empty

-- | Read the next complete top-level S-expression as raw 'Text'.
--
--   * @'Right' ('Just' frame)@ — a complete frame;
--   * @'Right' 'Nothing'@ — the stream ended cleanly with no further frame;
--   * @'Left' err@ — a framing error (e.g. unbalanced parentheses, EOF inside a
--     string).
readSExpr :: HandleReader -> IO (Either FrameError (Maybe Text))
readSExpr hr = do
  leftover <- readIORef (hrLeftover hr)
  drive (frameSExpr leftover)
  where
    drive (Done frame rest) = do
      writeIORef (hrLeftover hr) rest
      pure (Right (Just frame))
    drive (Failed EndOfInput _) = pure (Right Nothing)
    drive (Failed e _)          = pure (Left e)
    drive (Partial k)           = do
      chunk <- T.hGetChunk (hrHandle hr)  -- "" at EOF; never reads more than available
      drive (k chunk)

-- | Read and parse the next complete command.  Returns @Right Nothing@ at a
-- clean end of stream, @Left msg@ on a framing or syntax error.
readCommand :: HandleReader -> IO (Either String (Maybe (Command SrcSpan)))
readCommand hr = do
  r <- readSExpr hr
  pure $ case r of
    Left fe          -> Left ("framing error: " ++ show fe)
    Right Nothing    -> Right Nothing
    Right (Just txt) -> case parse (sc *> pCommand <* eof) "<handle>" txt of
      Left e  -> Left (errorBundlePretty e)
      Right c -> Right (Just c)