StreamParse.hs

module Chiasma.Native.StreamParse(
  parseConduit,
  parseBlocks,
  TmuxOutputBlock(..),
) where

import Conduit (ConduitT, mapC, (.|))
import Control.Monad.Catch (MonadThrow)
import Data.Attoparsec.ByteString (Parser)
import Data.Conduit.Attoparsec (conduitParser)
import qualified Data.Text as T (pack)
import Text.Parser.Char (CharParsing, anyChar, newline, string)
import Text.Parser.Combinators (choice, manyTill, notFollowedBy, skipMany, try)
import Text.Parser.LookAhead (LookAheadParsing, lookAhead)

data End =
  EndSuccess
  |
  EndError
  deriving (Eq, Show)

data TmuxOutputBlock =
  Success [Text]
  |
  Error [Text]
  deriving (Eq, Show)

tillEol :: (Alternative m, CharParsing m) => m Text
tillEol = T.pack <$> manyTill anyChar newline

beginLine :: (Alternative m, CharParsing m, Monad m) => m ()
beginLine = void $ string "%begin" >> tillEol

endLine :: (Alternative m, CharParsing m) => m End
endLine = do
  end <- choice [EndSuccess <$ string "%end", EndError <$ string "%error"]
  _ <- tillEol
  return end

notBeginLine :: (Alternative m, CharParsing m, Monad m) => m ()
notBeginLine = void $ notFollowedBy (string "%begin") >> tillEol

-- |Parse a sequence of lines between a %start and a %end line.
-- Tmux pads output lines with a single space on both sides, so strip those if the leading one is present.
parseBlock :: (Alternative m, CharParsing m, Monad m, LookAheadParsing m) => m TmuxOutputBlock
parseBlock = do
  _ <- skipMany notBeginLine
  _ <- beginLine
  dataLines <- manyTill tillEol $ try $ lookAhead endLine
  end <- endLine
  return $ case end of
    EndSuccess -> Success dataLines
    EndError -> Error dataLines

parseBlocks :: (Alternative m, CharParsing m, Monad m, LookAheadParsing m) => m [TmuxOutputBlock]
parseBlocks = do
  result <- many (try parseBlock)
  skipMany tillEol
  return result

parser :: Parser TmuxOutputBlock
parser = parseBlock

parseConduit :: MonadThrow m => ConduitT ByteString TmuxOutputBlock m ()
parseConduit = conduitParser parser .| mapC snd