module Chiasma.Native.TmuxOutputBlock where

import Data.Attoparsec.ByteString (Parser)
import Data.ByteString.Internal (packChars)
import Prelude hiding (try)
import Text.Parser.Char (CharParsing, anyChar, newline, string)
import Text.Parser.Combinators (choice, manyTill, notFollowedBy, skipMany, try)
import Text.Parser.LookAhead (LookAheadParsing, lookAhead)

import Chiasma.Data.TmuxOutputBlock (End (EndError, EndSuccess), TmuxOutputBlock (Error, Success))

tillEol :: (Alternative m, CharParsing m) => m Text
tillEol :: forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
tillEol = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> ([Char] -> ByteString) -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
packChars ([Char] -> Text) -> m [Char] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m Char -> m [Char]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill m Char
forall (m :: * -> *). CharParsing m => m Char
anyChar m Char
forall (m :: * -> *). CharParsing m => m Char
newline

beginLine :: (Alternative m, CharParsing m, Monad m) => m ()
beginLine :: forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m) =>
m ()
beginLine = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
string [Char]
"%begin" m [Char] -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Text
forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
tillEol

endLine :: (Alternative m, CharParsing m) => m End
endLine :: forall (m :: * -> *). (Alternative m, CharParsing m) => m End
endLine = do
  End
end <- [m End] -> m End
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [End
EndSuccess End -> m [Char] -> m End
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
string [Char]
"%end", End
EndError End -> m [Char] -> m End
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
string [Char]
"%error"]
  Text
_ <- m Text
forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
tillEol
  pure End
end

notBeginLine :: (Alternative m, CharParsing m, Monad m) => m ()
notBeginLine :: forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m) =>
m ()
notBeginLine = m Text -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Text -> m ()) -> m Text -> m ()
forall a b. (a -> b) -> a -> b
$ m [Char] -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ([Char] -> m [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
string [Char]
"%begin") m () -> m Text -> m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Text
forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
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 :: forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m, LookAheadParsing m) =>
m TmuxOutputBlock
parseBlock = do
  ()
_ <- m () -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany m ()
forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m) =>
m ()
notBeginLine
  ()
_ <- m ()
forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m) =>
m ()
beginLine
  [Text]
dataLines <- m Text -> m End -> m [Text]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill m Text
forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
tillEol (m End -> m [Text]) -> m End -> m [Text]
forall a b. (a -> b) -> a -> b
$ m End -> m End
forall (m :: * -> *) a. Parsing m => m a -> m a
try (m End -> m End
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead m End
forall (m :: * -> *). (Alternative m, CharParsing m) => m End
endLine)
  End
end <- m End
forall (m :: * -> *). (Alternative m, CharParsing m) => m End
endLine
  pure $ case End
end of
    End
EndSuccess -> [Text] -> TmuxOutputBlock
Success [Text]
dataLines
    End
EndError -> [Text] -> TmuxOutputBlock
Error [Text]
dataLines

parseBlocks :: (Alternative m, CharParsing m, Monad m, LookAheadParsing m) => m [TmuxOutputBlock]
parseBlocks :: forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m, LookAheadParsing m) =>
m [TmuxOutputBlock]
parseBlocks = do
  [TmuxOutputBlock]
result <- m TmuxOutputBlock -> m [TmuxOutputBlock]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m TmuxOutputBlock -> m TmuxOutputBlock
forall (m :: * -> *) a. Parsing m => m a -> m a
try m TmuxOutputBlock
forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m, LookAheadParsing m) =>
m TmuxOutputBlock
parseBlock)
  m Text -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m ()
skipMany m Text
forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
tillEol
  pure [TmuxOutputBlock]
result

parser :: Parser TmuxOutputBlock
parser :: Parser TmuxOutputBlock
parser = Parser TmuxOutputBlock
forall (m :: * -> *).
(Alternative m, CharParsing m, Monad m, LookAheadParsing m) =>
m TmuxOutputBlock
parseBlock