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 (End -> End -> Bool
(End -> End -> Bool) -> (End -> End -> Bool) -> Eq End
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: End -> End -> Bool
$c/= :: End -> End -> Bool
== :: End -> End -> Bool
$c== :: End -> End -> Bool
Eq, Int -> End -> ShowS
[End] -> ShowS
End -> String
(Int -> End -> ShowS)
-> (End -> String) -> ([End] -> ShowS) -> Show End
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [End] -> ShowS
$cshowList :: [End] -> ShowS
show :: End -> String
$cshow :: End -> String
showsPrec :: Int -> End -> ShowS
$cshowsPrec :: Int -> End -> ShowS
Show)

data TmuxOutputBlock =
  Success [Text]
  |
  Error [Text]
  deriving (TmuxOutputBlock -> TmuxOutputBlock -> Bool
(TmuxOutputBlock -> TmuxOutputBlock -> Bool)
-> (TmuxOutputBlock -> TmuxOutputBlock -> Bool)
-> Eq TmuxOutputBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TmuxOutputBlock -> TmuxOutputBlock -> Bool
$c/= :: TmuxOutputBlock -> TmuxOutputBlock -> Bool
== :: TmuxOutputBlock -> TmuxOutputBlock -> Bool
$c== :: TmuxOutputBlock -> TmuxOutputBlock -> Bool
Eq, Int -> TmuxOutputBlock -> ShowS
[TmuxOutputBlock] -> ShowS
TmuxOutputBlock -> String
(Int -> TmuxOutputBlock -> ShowS)
-> (TmuxOutputBlock -> String)
-> ([TmuxOutputBlock] -> ShowS)
-> Show TmuxOutputBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TmuxOutputBlock] -> ShowS
$cshowList :: [TmuxOutputBlock] -> ShowS
show :: TmuxOutputBlock -> String
$cshow :: TmuxOutputBlock -> String
showsPrec :: Int -> TmuxOutputBlock -> ShowS
$cshowsPrec :: Int -> TmuxOutputBlock -> ShowS
Show)

tillEol :: (Alternative m, CharParsing m) => m Text
tillEol :: m Text
tillEol = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m Char -> m String
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 :: 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
$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"%begin" m String -> 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 :: m End
endLine = do
  End
end <- [m End] -> m End
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [End
EndSuccess End -> m String -> m End
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"%end", End
EndError End -> m String -> m End
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"%error"]
  Text
_ <- m Text
forall (m :: * -> *). (Alternative m, CharParsing m) => m Text
tillEol
  return End
end

notBeginLine :: (Alternative m, CharParsing m, Monad m) => m ()
notBeginLine :: 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 String -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"%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 :: 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) -> m End -> m End
forall a b. (a -> b) -> a -> b
$ 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
  return $ 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 :: 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
  return [TmuxOutputBlock]
result

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

parseConduit :: MonadThrow m => ConduitT ByteString TmuxOutputBlock m ()
parseConduit :: ConduitT ByteString TmuxOutputBlock m ()
parseConduit = Parser TmuxOutputBlock
-> ConduitT ByteString (PositionRange, TmuxOutputBlock) m ()
forall a (m :: * -> *) b.
(AttoparsecInput a, MonadThrow m) =>
Parser a b -> ConduitT a (PositionRange, b) m ()
conduitParser Parser TmuxOutputBlock
parser ConduitT ByteString (PositionRange, TmuxOutputBlock) m ()
-> ConduitM (PositionRange, TmuxOutputBlock) TmuxOutputBlock m ()
-> ConduitT ByteString TmuxOutputBlock m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((PositionRange, TmuxOutputBlock) -> TmuxOutputBlock)
-> ConduitM (PositionRange, TmuxOutputBlock) TmuxOutputBlock m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (PositionRange, TmuxOutputBlock) -> TmuxOutputBlock
forall a b. (a, b) -> b
snd