{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}

module PMS.Domain.Model.DS.Utility where

import System.Log.FastLogger
import Control.Monad.Logger
import Control.Lens
import System.FilePath
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Control.Exception.Safe as E
import qualified Data.Text as T
import Data.Char 
import Control.Monad
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Char8 as BS
import qualified Data.String.AnsiEscapeCodes.Strip.Text as ANSI
import qualified Data.Text.Encoding.Error as TEE
import qualified Control.Concurrent.STM as STM
import System.IO
import Data.List

import PMS.Domain.Model.DM.Type
import PMS.Domain.Model.DM.Constant



-- |
--
runFastLoggerT :: DomainData -> TimedFastLogger -> LoggingT IO a -> IO a
runFastLoggerT :: forall a. DomainData -> TimedFastLogger -> LoggingT IO a -> IO a
runFastLoggerT DomainData
dat TimedFastLogger
logger LoggingT IO a
app = do
  let logLevel :: LogLevel
logLevel = DomainData
datDomainData -> Getting LogLevel DomainData LogLevel -> LogLevel
forall s a. s -> Getting a s a -> a
^.Getting LogLevel DomainData LogLevel
Lens' DomainData LogLevel
logLevelDomainData
      
  LoggingT IO a
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> IO a
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT ((Text -> LogLevel -> Bool) -> LoggingT IO a -> LoggingT IO a
forall (m :: * -> *) a.
(Text -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger (LogLevel -> Text -> LogLevel -> Bool
filterByLevel LogLevel
logLevel) LoggingT IO a
app) ((Loc -> Text -> LogLevel -> LogStr -> IO ()) -> IO a)
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> IO a
forall a b. (a -> b) -> a -> b
$ TimedFastLogger -> Loc -> Text -> LogLevel -> LogStr -> IO ()
output TimedFastLogger
logger 

  where
    -- |
    --
    output :: TimedFastLogger
           -> Loc
           -> LogSource
           -> LogLevel
           -> LogStr
           -> IO ()
    output :: TimedFastLogger -> Loc -> Text -> LogLevel -> LogStr -> IO ()
output TimedFastLogger
l Loc
a Text
b LogLevel
c LogStr
d = do
      let msg :: LogStr
msg = Loc -> Text -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
a Text
b LogLevel
c LogStr
d
      TimedFastLogger
l (\FormattedTime
ts -> FormattedTime -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr FormattedTime
ts LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
" " LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
msg)

    -- |
    --
    filterByLevel :: LogLevel -> LogSource -> LogLevel -> Bool
    filterByLevel :: LogLevel -> Text -> LogLevel -> Bool
filterByLevel LogLevel
target Text
_ LogLevel
actual = LogLevel
actual LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
target



-- |
--
createLogger :: DomainData -> String -> IO (TimedFastLogger, IO ())
createLogger :: DomainData -> [Char] -> IO (TimedFastLogger, IO ())
createLogger DomainData
dat [Char]
logFile = FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
_TIME_FORMAT IO (IO FormattedTime)
-> (IO FormattedTime -> IO (TimedFastLogger, IO ()))
-> IO (TimedFastLogger, IO ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe [Char] -> IO FormattedTime -> IO (TimedFastLogger, IO ())
withDir (DomainData
datDomainData
-> Getting (Maybe [Char]) DomainData (Maybe [Char]) -> Maybe [Char]
forall s a. s -> Getting a s a -> a
^.Getting (Maybe [Char]) DomainData (Maybe [Char])
Lens' DomainData (Maybe [Char])
logDirDomainData)
  where
    withDir :: Maybe [Char] -> IO FormattedTime -> IO (TimedFastLogger, IO ())
withDir  Maybe [Char]
Nothing  IO FormattedTime
tcache = IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
tcache (LogType -> IO (TimedFastLogger, IO ()))
-> LogType -> IO (TimedFastLogger, IO ())
forall a b. (a -> b) -> a -> b
$ BufSize -> LogType
LogStderr BufSize
defaultBufSize
    withDir (Just [Char]
dr) IO FormattedTime
tcache = IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
tcache (LogType -> IO (TimedFastLogger, IO ()))
-> LogType -> IO (TimedFastLogger, IO ())
forall a b. (a -> b) -> a -> b
$ [Char] -> BufSize -> LogType
LogFileNoRotate ([Char]
dr [Char] -> [Char] -> [Char]
</> [Char]
logFile) BufSize
defaultBufSize


-- |
--
str2lbs :: String -> BSL.ByteString
str2lbs :: [Char] -> ByteString
str2lbs = Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> ([Char] -> Text) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
TL.pack

-- |
--
lbs2str :: BSL.ByteString -> String
lbs2str :: ByteString -> [Char]
lbs2str = Text -> [Char]
TL.unpack(Text -> [Char]) -> (ByteString -> Text) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TLE.decodeUtf8


-- |
--  [ ";", "&&", "|", "$", "`", "<", ">", "\\", "\"", "..", "/"]
--
invalidChars :: [T.Text]
invalidChars :: [Text]
invalidChars =
#ifdef mingw32_HOST_OS
  [ "&&", "||", "|", ".."]
#else
  [ Text
"&&", Text
"||", Text
"|", Text
".."]
#endif

-- |
--
invalidCmds :: [String]
invalidCmds :: [[Char]]
invalidCmds = 
#ifdef mingw32_HOST_OS
  [
    "del", "erase", "rd", "rmdir", "format"
  , "shutdown", "restart", "taskkill"
  ]
#else
  [
    [Char]
"rm", [Char]
"mv", [Char]
"dd", [Char]
"chmod", [Char]
"chown"
  , [Char]
"shutdown", [Char]
"reboot", [Char]
"kill", [Char]
"nc"
  ]
#endif


-- |
--
validateMessage :: String -> IO String
validateMessage :: [Char] -> IO [Char]
validateMessage [Char]
cmd = case [Char] -> [[Char]]
words [Char]
cmd of
  [] -> [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cmd
  ([Char]
c : [[Char]]
args) -> do
    [Char]
_ <- [Char] -> IO [Char]
validateCommand [Char]
c
    [[Char]]
_ <- [[Char]] -> IO [[Char]]
validateArgs [[Char]]
args
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cmd

-- |
--
validateCommand :: String -> IO String
validateCommand :: [Char] -> IO [Char]
validateCommand [Char]
cmd = do
  let tcmd :: Text
tcmd = [Char] -> Text
T.pack [Char]
cmd

  (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Text
seqStr ->
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
seqStr Text -> Text -> Bool
`T.isInfixOf` Text
tcmd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            [Char] -> IO ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Command contains forbidden sequence: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
seqStr
        ) [Text]
invalidChars

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Char]
cmd [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
invalidCmds) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Command is forbidden: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAllowedChar) [Char]
cmd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Command contains disallowed characters: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd

  [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
cmd
  where
    isAllowedChar :: Char -> Bool
    isAllowedChar :: Char -> Bool
isAllowedChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"-._" :: String)


-- |
--
validateArgs :: [String] -> IO [String]
validateArgs :: [[Char]] -> IO [[Char]]
validateArgs = ([Char] -> IO [Char]) -> [[Char]] -> IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO [Char]
validateArg

-- |
--
validateArg :: String -> IO String
validateArg :: [Char] -> IO [Char]
validateArg [Char]
arg = do
  let tArg :: Text
tArg = [Char] -> Text
T.pack [Char]
arg
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isInfixOf` Text
tArg) [Text]
invalidChars) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> IO ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Argument contains forbidden sequences: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
arg
  [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
arg



-- |
--
expect :: STM.TMVar () -> IO BS.ByteString -> [String] -> IO (Maybe String)
expect :: TMVar () -> IO FormattedTime -> [[Char]] -> IO (Maybe [Char])
expect TMVar ()
lock IO FormattedTime
feed [[Char]]
prompts = STM (Maybe ()) -> IO (Maybe ())
forall a. STM a -> IO a
STM.atomically (TMVar () -> STM (Maybe ())
forall a. TMVar a -> STM (Maybe a)
STM.tryTakeTMVar TMVar ()
lock) IO (Maybe ())
-> (Maybe () -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Maybe ()
Nothing -> do
    Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
"[INFO] expect running. skip."
    Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
forall a. Maybe a
Nothing
  Just () -> (IO (Maybe [Char])
 -> (SomeException -> IO (Maybe [Char])) -> IO (Maybe [Char]))
-> (SomeException -> IO (Maybe [Char]))
-> IO (Maybe [Char])
-> IO (Maybe [Char])
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO (Maybe [Char])
-> (SomeException -> IO (Maybe [Char])) -> IO (Maybe [Char])
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IO (Maybe [Char])
exception (IO (Maybe [Char]) -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ (IO (Maybe [Char]) -> IO () -> IO (Maybe [Char]))
-> IO () -> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO (Maybe [Char]) -> IO () -> IO (Maybe [Char])
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
E.finally IO ()
finalize (IO (Maybe [Char]) -> IO (Maybe [Char]))
-> IO (Maybe [Char]) -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] expect: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
prompts
    FormattedTime
output <- IO FormattedTime -> [[Char]] -> IO FormattedTime
readUntilPrompt IO FormattedTime
feed [[Char]]
prompts
    
    -- let result = T.unpack (TE.decodeUtf8 output)
    let result :: [Char]
result = Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> Text
ANSI.stripAnsiEscapeCodes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ OnDecodeError -> FormattedTime -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode FormattedTime
output
    Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
result)

  where
    -- |
    --
    exception :: E.SomeException -> IO (Maybe String)
    exception :: SomeException -> IO (Maybe [Char])
exception SomeException
e = do
      Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] expect exception: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
      Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> (SomeException -> Maybe [Char])
-> SomeException
-> IO (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char])
-> (SomeException -> [Char]) -> SomeException -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
forall a. Show a => a -> [Char]
show (SomeException -> IO (Maybe [Char]))
-> SomeException -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ SomeException
e

    -- |
    --
    finalize :: IO ()
    finalize :: IO ()
finalize = STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar () -> () -> STM ()
forall a. TMVar a -> a -> STM ()
STM.putTMVar TMVar ()
lock ()

-- |
--
readUntilPrompt :: IO BS.ByteString -> [String] -> IO BS.ByteString
readUntilPrompt :: IO FormattedTime -> [[Char]] -> IO FormattedTime
readUntilPrompt IO FormattedTime
feed [[Char]]
prompts = FormattedTime -> IO FormattedTime
go FormattedTime
BS.empty
  where
    ([[Char]]
negativePrompts, [[Char]]
positivePrompts) = ([Char] -> Bool) -> [[Char]] -> ([[Char]], [[Char]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\[Char]
s -> Bool -> Bool
not ([Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
s) Bool -> Bool -> Bool
&& [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!') [[Char]]
prompts
    promptBsList :: [FormattedTime]
promptBsList    = ([Char] -> FormattedTime) -> [[Char]] -> [FormattedTime]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> FormattedTime
BS.pack ([[Char]] -> [FormattedTime]) -> [[Char]] -> [FormattedTime]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!')) [[Char]]
positivePrompts
    rejectPromptBs :: [FormattedTime]
rejectPromptBs  = ([Char] -> FormattedTime) -> [[Char]] -> [FormattedTime]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> FormattedTime
BS.pack ([[Char]] -> [FormattedTime]) -> [[Char]] -> [FormattedTime]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (BufSize -> [Char] -> [Char]
forall a. BufSize -> [a] -> [a]
drop BufSize
1) [[Char]]
negativePrompts

    foundPrompt :: FormattedTime -> Bool
foundPrompt FormattedTime
acc =
      (FormattedTime -> Bool) -> [FormattedTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FormattedTime -> FormattedTime -> Bool
`BS.isInfixOf` FormattedTime
acc) [FormattedTime]
promptBsList Bool -> Bool -> Bool
&&
      (FormattedTime -> Bool) -> [FormattedTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (FormattedTime -> Bool) -> FormattedTime -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormattedTime -> FormattedTime -> Bool
`BS.isInfixOf` FormattedTime
acc)) [FormattedTime]
rejectPromptBs

    go :: FormattedTime -> IO FormattedTime
go FormattedTime
acc = do
      FormattedTime
chunk <- IO FormattedTime
feed
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FormattedTime
"\ESC[6n" FormattedTime -> FormattedTime -> Bool
`BS.isInfixOf` FormattedTime
chunk) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Char] -> IO ()
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
[Char] -> m a
E.throwString [Char]
"Unsupported: Detected cursor position report request (ESC[6n)."

      let txt :: Text
txt = OnDecodeError -> FormattedTime -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode FormattedTime
chunk
      Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] chunk:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
txt

      let acc' :: FormattedTime
acc' = FormattedTime -> FormattedTime -> FormattedTime
BS.append FormattedTime
acc FormattedTime
chunk
      if FormattedTime -> Bool
foundPrompt FormattedTime
acc'
        then FormattedTime -> IO FormattedTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FormattedTime
acc'
        else FormattedTime -> IO FormattedTime
go FormattedTime
acc'


{-
readUntilPrompt :: IO BS.ByteString -> [String] -> IO BS.ByteString
readUntilPrompt feed prompts = go BS.empty
  where
    promptBsList = map BS.pack prompts

    foundPrompt acc = any (`BS.isInfixOf` acc) promptBsList

    go acc = do
      chunk <- feed
      when ("\ESC[6n" `BS.isInfixOf` chunk) $ do
        E.throwString "Unsupported: Detected cursor position report request (ESC[6n)."

      -- let txt = ANSI.stripAnsiEscapeCodes $ TE.decodeUtf8With TEE.lenientDecode chunk
      let txt = TE.decodeUtf8With TEE.lenientDecode chunk
      hPutStrLn stderr $ "[INFO] chunk:\n" ++ T.unpack txt

      let acc' = BS.append acc chunk
      if foundPrompt acc'
        then return acc'
        else go acc'



readUntilPrompt :: Pty -> [String] -> IO BS.ByteString
readUntilPrompt pms prompts = go BS.empty T.empty
  where
    promptTextList = map T.pack prompts

    foundPrompt :: T.Text -> Bool
    foundPrompt txt = any (`T.isInfixOf` txt) promptTextList

    go accBs accTxt = do
      chunk <- readPty pms
      let txt = ANSI.stripAnsiEscapeCodes $ TE.decodeUtf8With TEE.lenientDecode chunk
      hPutStrLn stderr $ "[INFO] chunk:\n" ++ T.unpack txt

      when ("\ESC[6n" `BS.isInfixOf` chunk) $ do
        hPutStrLn stderr "[INFO] Detected cursor position report request, replying with ESC[1;1R"
        writePty pms (DBS.pack ([0x1B :: Word8, 0x5B :: Word8] ++ map (fromIntegral . ord) "0;0R"))

      let accBs' = BS.append accBs chunk
          accTxt' = T.append accTxt txt
      if foundPrompt accTxt'
        then return accBs'
        else go accBs' accTxt'
-}