module Haskell.Debug.Adapter.Utility where

import Control.Lens
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Data.Conduit.Binary as C
import qualified Data.Conduit as C
import qualified Data.Conduit.List as C
import Control.Monad.Except
import Control.Monad.State.Lazy
import qualified System.IO as S
import qualified System.Process as S
import qualified System.Exit as S
import Control.Concurrent.MVar
import qualified System.Log.Logger as L
import qualified Data.List as L
import qualified Control.Exception.Safe as E

import qualified Haskell.DAP as DAP
import Haskell.Debug.Adapter.Type
import Haskell.Debug.Adapter.Constant

-- |
--
str2bs :: String -> BS.ByteString
str2bs :: String -> ByteString
str2bs = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- |
--
bs2str :: BS.ByteString -> String
bs2str :: ByteString -> String
bs2str = Text -> String
T.unpack(Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8

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

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


-- |
--
--
loadFile :: FilePath -> IO BS.ByteString
loadFile :: String -> IO ByteString
loadFile String
path = do
  [ByteString]
bs <- ConduitT () Void (ResourceT IO) [ByteString] -> IO [ByteString]
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes
      (ConduitT () Void (ResourceT IO) [ByteString] -> IO [ByteString])
-> ConduitT () Void (ResourceT IO) [ByteString] -> IO [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
String -> ConduitT i ByteString m ()
C.sourceFile String
path
      ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) [ByteString]
-> ConduitT () Void (ResourceT IO) [ByteString]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM ByteString Void (ResourceT IO) [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
C.consume
  ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat [ByteString]
bs


-- |
--
--
saveFile :: FilePath -> BS.ByteString -> IO ()
saveFile :: String -> ByteString -> IO ()
saveFile String
path ByteString
cont = String -> ByteString -> IO ()
saveFileBSL String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
cont


-- |
--
--
saveFileBSL :: FilePath -> BSL.ByteString -> IO ()
saveFileBSL :: String -> ByteString -> IO ()
saveFileBSL String
path ByteString
cont = ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes
  (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
C.sourceLbs ByteString
cont
  ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| String -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
String -> ConduitT ByteString o m ()
C.sinkFile String
path


-- |
--
--
add2File :: FilePath -> BS.ByteString -> IO ()
add2File :: String -> ByteString -> IO ()
add2File String
path ByteString
cont = String -> ByteString -> IO ()
add2FileBSL String
path (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
cont

-- |
--
--
add2FileBSL :: FilePath -> BSL.ByteString -> IO ()
add2FileBSL :: String -> ByteString -> IO ()
add2FileBSL String
path ByteString
cont = ConduitT () Void (ResourceT IO) () -> IO ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes
  (ConduitT () Void (ResourceT IO) () -> IO ())
-> ConduitT () Void (ResourceT IO) () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
C.sourceLbs ByteString
cont
  ConduitT () ByteString (ResourceT IO) ()
-> ConduitM ByteString Void (ResourceT IO) ()
-> ConduitT () Void (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| IO Handle -> ConduitM ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
IO Handle -> ConduitT ByteString o m ()
C.sinkIOHandle IO Handle
hdl

  where hdl :: IO Handle
hdl = String -> IOMode -> IO Handle
S.openFile String
path IOMode
S.AppendMode


-- |
--  utility
--
showEE :: (Show e) => Either e a -> Either ErrMsg a
showEE :: Either e a -> Either String a
showEE (Right a
v) = a -> Either String a
forall a b. b -> Either a b
Right a
v
showEE (Left  e
e) = String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ e -> String
forall a. Show a => a -> String
show e
e


-- |
--
runApp :: AppStores -> AppContext a -> IO (Either ErrMsg (a, AppStores))
runApp :: AppStores -> AppContext a -> IO (Either String (a, AppStores))
runApp AppStores
dat AppContext a
app = ExceptT String IO (a, AppStores)
-> IO (Either String (a, AppStores))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO (a, AppStores)
 -> IO (Either String (a, AppStores)))
-> ExceptT String IO (a, AppStores)
-> IO (Either String (a, AppStores))
forall a b. (a -> b) -> a -> b
$ AppContext a -> AppStores -> ExceptT String IO (a, AppStores)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT AppContext a
app AppStores
dat


-- |
--
addRequest :: WrapRequest -> AppContext ()
addRequest :: WrapRequest -> AppContext ()
addRequest WrapRequest
req = do
  MVar [WrapRequest]
reqsMVar <- Getting (MVar [WrapRequest]) AppStores (MVar [WrapRequest])
-> AppStores -> MVar [WrapRequest]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar [WrapRequest]) AppStores (MVar [WrapRequest])
Lens' AppStores (MVar [WrapRequest])
reqStoreAppStores (AppStores -> MVar [WrapRequest])
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) (MVar [WrapRequest])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  [WrapRequest]
reqs <- IO [WrapRequest]
-> StateT AppStores (ExceptT String IO) [WrapRequest]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WrapRequest]
 -> StateT AppStores (ExceptT String IO) [WrapRequest])
-> IO [WrapRequest]
-> StateT AppStores (ExceptT String IO) [WrapRequest]
forall a b. (a -> b) -> a -> b
$ MVar [WrapRequest] -> IO [WrapRequest]
forall a. MVar a -> IO a
takeMVar MVar [WrapRequest]
reqsMVar
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ MVar [WrapRequest] -> [WrapRequest] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [WrapRequest]
reqsMVar ([WrapRequest]
reqs[WrapRequest] -> [WrapRequest] -> [WrapRequest]
forall a. [a] -> [a] -> [a]
++[WrapRequest
req])


-- |
--  High priority
--
addRequestHP :: WrapRequest -> AppContext ()
addRequestHP :: WrapRequest -> AppContext ()
addRequestHP WrapRequest
req = do
  MVar [WrapRequest]
reqsMVar <- Getting (MVar [WrapRequest]) AppStores (MVar [WrapRequest])
-> AppStores -> MVar [WrapRequest]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar [WrapRequest]) AppStores (MVar [WrapRequest])
Lens' AppStores (MVar [WrapRequest])
reqStoreAppStores (AppStores -> MVar [WrapRequest])
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) (MVar [WrapRequest])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  [WrapRequest]
reqs <- IO [WrapRequest]
-> StateT AppStores (ExceptT String IO) [WrapRequest]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [WrapRequest]
 -> StateT AppStores (ExceptT String IO) [WrapRequest])
-> IO [WrapRequest]
-> StateT AppStores (ExceptT String IO) [WrapRequest]
forall a b. (a -> b) -> a -> b
$ MVar [WrapRequest] -> IO [WrapRequest]
forall a. MVar a -> IO a
takeMVar MVar [WrapRequest]
reqsMVar
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ MVar [WrapRequest] -> [WrapRequest] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [WrapRequest]
reqsMVar (WrapRequest
reqWrapRequest -> [WrapRequest] -> [WrapRequest]
forall a. a -> [a] -> [a]
:[WrapRequest]
reqs)


-- |
--
addResponse :: Response -> AppContext ()
addResponse :: Response -> AppContext ()
addResponse Response
res = do
  AppStores
appData <- StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  let mvar :: MVar [Response]
mvar = AppStores
appDataAppStores
-> Getting (MVar [Response]) AppStores (MVar [Response])
-> MVar [Response]
forall s a. s -> Getting a s a -> a
^.Getting (MVar [Response]) AppStores (MVar [Response])
Lens' AppStores (MVar [Response])
resStoreAppStores
  [Response]
ress <- IO [Response] -> StateT AppStores (ExceptT String IO) [Response]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Response] -> StateT AppStores (ExceptT String IO) [Response])
-> IO [Response] -> StateT AppStores (ExceptT String IO) [Response]
forall a b. (a -> b) -> a -> b
$ MVar [Response] -> IO [Response]
forall a. MVar a -> IO a
takeMVar MVar [Response]
mvar
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ MVar [Response] -> [Response] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [Response]
mvar ([Response]
ress[Response] -> [Response] -> [Response]
forall a. [a] -> [a] -> [a]
++[Response
res])


-- |
--
getIncreasedResponseSequence :: AppContext Int
getIncreasedResponseSequence :: AppContext Int
getIncreasedResponseSequence = do
  AppStores
appData <- StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  let cnt :: Int
cnt = AppStores
appDataAppStores -> Getting Int AppStores Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int AppStores Int
Lens' AppStores Int
resSeqAppStores
      seq :: Int
seq = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cnt
  AppStores -> AppContext ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put AppStores
appData {_resSeqAppStores :: Int
_resSeqAppStores = Int
seq}
  Int -> AppContext Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
seq

-- |
--
sendConsoleEvent :: String -> AppContext ()
sendConsoleEvent :: String -> AppContext ()
sendConsoleEvent = String -> String -> AppContext ()
sendOutputEventWithType String
"console"

-- |
--
sendConsoleEventLF :: String -> AppContext ()
sendConsoleEventLF :: String -> AppContext ()
sendConsoleEventLF String
x = String -> AppContext ()
sendConsoleEvent (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
_LF_STR)


-- |
--
sendStdoutEvent :: String -> AppContext ()
sendStdoutEvent :: String -> AppContext ()
sendStdoutEvent = String -> String -> AppContext ()
sendOutputEventWithType String
"stdout"


-- |
--
sendStdoutEventLF :: String -> AppContext ()
sendStdoutEventLF :: String -> AppContext ()
sendStdoutEventLF String
x = String -> AppContext ()
sendStdoutEvent (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
_LF_STR)


-- |
--
sendErrorEvent :: String -> AppContext ()
sendErrorEvent :: String -> AppContext ()
sendErrorEvent = String -> String -> AppContext ()
sendOutputEventWithType String
"stderr"

-- |
--
sendErrorEventLF :: String -> AppContext ()
sendErrorEventLF :: String -> AppContext ()
sendErrorEventLF String
x = String -> AppContext ()
sendErrorEvent (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
_LF_STR)


-- |
--
sendOutputEventWithType :: String -> String -> AppContext ()
sendOutputEventWithType :: String -> String -> AppContext ()
sendOutputEventWithType String
evType String
msg = do
  Int
resSeq <- AppContext Int
getIncreasedResponseSequence
  let body :: OutputEventBody
body = String -> String -> Maybe String -> OutputEventBody
DAP.OutputEventBody String
evType String
msg Maybe String
forall a. Maybe a
Nothing
      outEvt :: OutputEvent
outEvt = OutputEvent
DAP.defaultOutputEvent {
                seqOutputEvent :: Int
DAP.seqOutputEvent = Int
resSeq
              , bodyOutputEvent :: OutputEventBody
DAP.bodyOutputEvent = OutputEventBody
body
              }

  Response -> AppContext ()
addResponse (Response -> AppContext ()) -> Response -> AppContext ()
forall a b. (a -> b) -> a -> b
$ OutputEvent -> Response
OutputEvent OutputEvent
outEvt

-- |
--
debugEV :: String -> String -> AppContext ()
debugEV :: String -> String -> AppContext ()
debugEV String
name String
msg = do
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.debugM String
name String
msg
  Priority -> String -> String -> AppContext ()
logEV Priority
L.DEBUG String
name String
msg

-- |
--
infoEV :: String -> String -> AppContext ()
infoEV :: String -> String -> AppContext ()
infoEV String
name String
msg = do
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.infoM String
name String
msg
  Priority -> String -> String -> AppContext ()
logEV Priority
L.INFO String
name String
msg

-- |
--
warnEV :: String -> String -> AppContext ()
warnEV :: String -> String -> AppContext ()
warnEV String
name String
msg = do
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.warningM String
name String
msg
  Priority -> String -> String -> AppContext ()
logEV Priority
L.WARNING String
name String
msg

-- |
--
errorEV :: String -> String -> AppContext ()
errorEV :: String -> String -> AppContext ()
errorEV String
name String
msg = do
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.errorM String
name String
msg
  Priority -> String -> String -> AppContext ()
logEV Priority
L.ERROR String
name String
msg

-- |
--
criticalEV :: String -> String -> AppContext ()
criticalEV :: String -> String -> AppContext ()
criticalEV String
name String
msg = do
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.criticalM String
name String
msg
  Priority -> String -> String -> AppContext ()
logEV Priority
L.CRITICAL String
name String
msg

-- |
--
logEV :: L.Priority -> String -> String -> AppContext ()
logEV :: Priority -> String -> String -> AppContext ()
logEV Priority
pr String
name String
msg = do
  MVar Priority
mvar <- Getting (MVar Priority) AppStores (MVar Priority)
-> AppStores -> MVar Priority
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar Priority) AppStores (MVar Priority)
Lens' AppStores (MVar Priority)
logPriorityAppStores (AppStores -> MVar Priority)
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) (MVar Priority)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  Priority
logPR <- IO Priority -> StateT AppStores (ExceptT String IO) Priority
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Priority -> StateT AppStores (ExceptT String IO) Priority)
-> IO Priority -> StateT AppStores (ExceptT String IO) Priority
forall a b. (a -> b) -> a -> b
$ MVar Priority -> IO Priority
forall a. MVar a -> IO a
readMVar MVar Priority
mvar
  let msg' :: String
msg' = if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf String
_LF_STR String
msg then String
msg else String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
_LF_STR

  Bool -> AppContext () -> AppContext ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
pr Priority -> Priority -> Bool
forall a. Ord a => a -> a -> Bool
>= Priority
logPR) (AppContext () -> AppContext ()) -> AppContext () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ do
    String -> AppContext ()
sendStdoutEvent (String -> AppContext ()) -> String -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Priority -> String
forall a. Show a => a -> String
show Priority
pr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"][" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg'



-- |
--
sendPauseResponse :: DAP.PauseRequest -> AppContext ()
sendPauseResponse :: PauseRequest -> AppContext ()
sendPauseResponse PauseRequest
req = do
  Int
resSeq <- AppContext Int
getIncreasedResponseSequence

  let res :: PauseResponse
res = PauseResponse
DAP.defaultPauseResponse {
            seqPauseResponse :: Int
DAP.seqPauseResponse         = Int
resSeq
          , request_seqPauseResponse :: Int
DAP.request_seqPauseResponse = PauseRequest -> Int
DAP.seqPauseRequest PauseRequest
req
          , successPauseResponse :: Bool
DAP.successPauseResponse     = Bool
False
          , messagePauseResponse :: String
DAP.messagePauseResponse     = String
"pause request is not supported."
          }

  Response -> AppContext ()
addResponse (Response -> AppContext ()) -> Response -> AppContext ()
forall a b. (a -> b) -> a -> b
$ PauseResponse -> Response
PauseResponse PauseResponse
res


-- |
--
--   phoityne -> haskell-dap
--   encoding RequestArgument to [Word8] because of using ghci command line interface.
--
showDAP :: Show a => a -> String
showDAP :: a -> String
showDAP = [Word8] -> String
forall a. Show a => a -> String
show ([Word8] -> String) -> (a -> [Word8]) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> (a -> ByteString) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show


-- |
--
sendTerminatedEvent :: AppContext ()
sendTerminatedEvent :: AppContext ()
sendTerminatedEvent = do
  Int
resSeq <- AppContext Int
getIncreasedResponseSequence
  let evt :: TerminatedEvent
evt = TerminatedEvent
DAP.defaultTerminatedEvent {
            seqTerminatedEvent :: Int
DAP.seqTerminatedEvent = Int
resSeq
          }

  Response -> AppContext ()
addResponse (Response -> AppContext ()) -> Response -> AppContext ()
forall a b. (a -> b) -> a -> b
$ TerminatedEvent -> Response
TerminatedEvent TerminatedEvent
evt


-- |
--
sendRestartEvent :: AppContext ()
sendRestartEvent :: AppContext ()
sendRestartEvent = do
  Int
resSeq <- AppContext Int
getIncreasedResponseSequence
  let evt :: TerminatedEvent
evt = TerminatedEvent
DAP.defaultTerminatedEvent {
            seqTerminatedEvent :: Int
DAP.seqTerminatedEvent = Int
resSeq
          , bodyTerminatedEvent :: TerminatedEventBody
DAP.bodyTerminatedEvent = TerminatedEventBody
DAP.defaultTerminatedEventBody {
              restartTerminatedEventBody :: Bool
DAP.restartTerminatedEventBody = Bool
True
            }
          }

  Response -> AppContext ()
addResponse (Response -> AppContext ()) -> Response -> AppContext ()
forall a b. (a -> b) -> a -> b
$ TerminatedEvent -> Response
TerminatedEvent TerminatedEvent
evt



-- |
--
sendExitedEvent :: AppContext ()
sendExitedEvent :: AppContext ()
sendExitedEvent = do
  Int
code <- AppContext Int
getExitCode
  Int
resSeq <- AppContext Int
getIncreasedResponseSequence
  let evt :: ExitedEvent
evt = ExitedEvent
DAP.defaultExitedEvent {
            seqExitedEvent :: Int
DAP.seqExitedEvent = Int
resSeq
          , bodyExitedEvent :: ExitedEventBody
DAP.bodyExitedEvent = ExitedEventBody
DAP.defaultExitedEventBody {
                exitCodeExitedEventBody :: Int
DAP.exitCodeExitedEventBody = Int
code
              }
          }

  Response -> AppContext ()
addResponse (Response -> AppContext ()) -> Response -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ExitedEvent -> Response
ExitedEvent ExitedEvent
evt

  where
    getExitCode :: AppContext Int
getExitCode = AppContext (Maybe Int)
getGHCiExitCode AppContext (Maybe Int)
-> (Maybe Int -> AppContext Int) -> AppContext Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Int
c -> Int -> AppContext Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
c
      Maybe Int
Nothing -> do
        IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.infoM String
_LOG_NAME String
"force kill ghci."
        AppContext Int
force

    force :: AppContext Int
force = AppContext ()
killGHCi AppContext () -> AppContext (Maybe Int) -> AppContext (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppContext (Maybe Int)
getGHCiExitCode AppContext (Maybe Int)
-> (Maybe Int -> AppContext Int) -> AppContext Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just Int
c -> Int -> AppContext Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
c
      Maybe Int
Nothing -> do
        IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
L.infoM String
_LOG_NAME String
"force kill ghci failed."
        Int -> AppContext Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1  -- kill ghci failed. error exit anyway.

-- |
--
getGHCiExitCode :: AppContext (Maybe Int)
getGHCiExitCode :: AppContext (Maybe Int)
getGHCiExitCode = do
  MVar GHCiProc
procMVar <- Getting (MVar GHCiProc) AppStores (MVar GHCiProc)
-> AppStores -> MVar GHCiProc
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar GHCiProc) AppStores (MVar GHCiProc)
Lens' AppStores (MVar GHCiProc)
ghciProcAppStores (AppStores -> MVar GHCiProc)
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) (MVar GHCiProc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  GHCiProc
proc <- IO GHCiProc -> StateT AppStores (ExceptT String IO) GHCiProc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GHCiProc -> StateT AppStores (ExceptT String IO) GHCiProc)
-> IO GHCiProc -> StateT AppStores (ExceptT String IO) GHCiProc
forall a b. (a -> b) -> a -> b
$ MVar GHCiProc -> IO GHCiProc
forall a. MVar a -> IO a
readMVar MVar GHCiProc
procMVar
  IO (Maybe ExitCode)
-> StateT AppStores (ExceptT String IO) (Maybe ExitCode)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ProcessHandle -> IO (Maybe ExitCode)
S.getProcessExitCode (GHCiProc
procGHCiProc
-> Getting ProcessHandle GHCiProc ProcessHandle -> ProcessHandle
forall s a. s -> Getting a s a -> a
^.Getting ProcessHandle GHCiProc ProcessHandle
Lens' GHCiProc ProcessHandle
procGHCiProc)) StateT AppStores (ExceptT String IO) (Maybe ExitCode)
-> (Maybe ExitCode -> AppContext (Maybe Int))
-> AppContext (Maybe Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just ExitCode
S.ExitSuccess -> Maybe Int -> AppContext (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> AppContext (Maybe Int))
-> Maybe Int -> AppContext (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
    Just (S.ExitFailure Int
c) -> Maybe Int -> AppContext (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> AppContext (Maybe Int))
-> Maybe Int -> AppContext (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
c
    Maybe ExitCode
Nothing -> Maybe Int -> AppContext (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing

-- |
--   On Windows, terminateProcess blocks for exiting.
--
killGHCi :: AppContext ()
killGHCi :: AppContext ()
killGHCi = do
  () -> AppContext ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  {-
  procMVar <- view ghciProcAppStores <$> get
  proc <- liftIO $ readMVar procMVar
  liftIO $ S.terminateProcess (proc^.procGHCiProc)
  -}

-- |
--
handleStoppedEventBody :: DAP.StoppedEventBody -> AppContext ()
handleStoppedEventBody :: StoppedEventBody -> AppContext ()
handleStoppedEventBody StoppedEventBody
body
  | String
"complete" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== StoppedEventBody -> String
DAP.reasonStoppedEventBody StoppedEventBody
body = do
      String -> AppContext ()
sendConsoleEventLF String
"debugging completed. "
      Bool
isReRun <- Getting Bool AppStores Bool -> AppStores -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool AppStores Bool
Lens' AppStores Bool
debugReRunableAppStores (AppStores -> Bool)
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
      Bool -> AppContext ()
handleReRun Bool
isReRun
  | Bool
otherwise = AppContext ()
sendStoppedEvent

  where
    handleReRun :: Bool -> AppContext ()
handleReRun Bool
True = do
      -- ghci and vscode can not rerun debugging without restart.
      -- sendContinuedEvent
      -- sendPauseEvent
      WrapRequest -> AppContext ()
addRequestHP (WrapRequest -> AppContext ()) -> WrapRequest -> AppContext ()
forall a b. (a -> b) -> a -> b
$ Request HdaInternalTransitRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest
                   (Request HdaInternalTransitRequest -> WrapRequest)
-> Request HdaInternalTransitRequest -> WrapRequest
forall a b. (a -> b) -> a -> b
$ HdaInternalTransitRequest -> Request HdaInternalTransitRequest
InternalTransitRequest
                   (HdaInternalTransitRequest -> Request HdaInternalTransitRequest)
-> HdaInternalTransitRequest -> Request HdaInternalTransitRequest
forall a b. (a -> b) -> a -> b
$ StateTransit -> HdaInternalTransitRequest
HdaInternalTransitRequest StateTransit
DebugRun_Contaminated

    handleReRun Bool
False = do
      WrapRequest -> AppContext ()
addRequestHP (WrapRequest -> AppContext ()) -> WrapRequest -> AppContext ()
forall a b. (a -> b) -> a -> b
$ Request HdaInternalTerminateRequest -> WrapRequest
forall a. Request a -> WrapRequest
WrapRequest
                   (Request HdaInternalTerminateRequest -> WrapRequest)
-> Request HdaInternalTerminateRequest -> WrapRequest
forall a b. (a -> b) -> a -> b
$ HdaInternalTerminateRequest -> Request HdaInternalTerminateRequest
InternalTerminateRequest
                   (HdaInternalTerminateRequest
 -> Request HdaInternalTerminateRequest)
-> HdaInternalTerminateRequest
-> Request HdaInternalTerminateRequest
forall a b. (a -> b) -> a -> b
$ String -> HdaInternalTerminateRequest
HdaInternalTerminateRequest String
""

    sendStoppedEvent :: AppContext ()
sendStoppedEvent = do
      Int
resSeq <- AppContext Int
getIncreasedResponseSequence
      let res :: StoppedEvent
res = StoppedEvent
DAP.defaultStoppedEvent {
                seqStoppedEvent :: Int
DAP.seqStoppedEvent = Int
resSeq
              , bodyStoppedEvent :: StoppedEventBody
DAP.bodyStoppedEvent = StoppedEventBody
body
              }

      Response -> AppContext ()
addResponse (Response -> AppContext ()) -> Response -> AppContext ()
forall a b. (a -> b) -> a -> b
$ StoppedEvent -> Response
StoppedEvent StoppedEvent
res

{-
    sendContinuedEvent = do
      resSeq <- getIncreasedResponseSequence
      let res = DAP.defaultContinuedEvent {
                DAP.seqContinuedEvent = resSeq
              }

      addResponse $ ContinuedEvent res

    sendPauseEvent = do
      resSeq <- getIncreasedResponseSequence
      let res = DAP.defaultStoppedEvent {
                DAP.seqStoppedEvent = resSeq
              , DAP.bodyStoppedEvent = DAP.defaultStoppedEventBody {
                  DAP.reasonStoppedEventBody = "pause"
                }
              }

      addResponse $ StoppedEvent res
-}

-- |
--
readLine :: S.Handle -> AppContext String
readLine :: Handle -> AppContext String
readLine Handle
hdl =   Handle -> AppContext Handle
isOpenHdl Handle
hdl
             AppContext Handle
-> (Handle -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext Handle
isReadableHdl
             AppContext Handle
-> (Handle -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext Handle
isNotEofHdl
             AppContext Handle
-> (Handle -> AppContext String) -> AppContext String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext String
go

  where
    go :: Handle -> AppContext String
go Handle
hdl = IO String -> AppContext String
forall a. IO a -> AppContext a
liftIOE (IO String -> AppContext String) -> IO String -> AppContext String
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
S.hGetLine Handle
hdl


-- |
--
readChar :: S.Handle -> AppContext String
readChar :: Handle -> AppContext String
readChar Handle
hdl = Handle -> AppContext Handle
isOpenHdl Handle
hdl
           AppContext Handle
-> (Handle -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext Handle
isReadableHdl
           AppContext Handle
-> (Handle -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext Handle
isNotEofHdl
           AppContext Handle
-> (Handle -> StateT AppStores (ExceptT String IO) Char)
-> StateT AppStores (ExceptT String IO) Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> StateT AppStores (ExceptT String IO) Char
go
           StateT AppStores (ExceptT String IO) Char
-> (Char -> AppContext String) -> AppContext String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> AppContext String
forall (m :: * -> *) a. Monad m => a -> m [a]
toString
           AppContext String
-> (String -> AppContext String) -> AppContext String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> AppContext String
isNotEmpty

  where
    go :: Handle -> StateT AppStores (ExceptT String IO) Char
go Handle
hdl = IO Char -> StateT AppStores (ExceptT String IO) Char
forall a. IO a -> AppContext a
liftIOE (IO Char -> StateT AppStores (ExceptT String IO) Char)
-> IO Char -> StateT AppStores (ExceptT String IO) Char
forall a b. (a -> b) -> a -> b
$ Handle -> IO Char
S.hGetChar Handle
hdl

    toString :: a -> m [a]
toString a
c = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
c]


-- |
--
readCharL :: S.Handle -> AppContext BSL.ByteString
readCharL :: Handle -> AppContext ByteString
readCharL Handle
hdl = Handle -> Int -> AppContext ByteString
readCharsL Handle
hdl Int
1


-- |
--
readCharsL :: S.Handle -> Int -> AppContext BSL.ByteString
readCharsL :: Handle -> Int -> AppContext ByteString
readCharsL Handle
hdl Int
c = Handle -> AppContext Handle
isOpenHdl Handle
hdl
               AppContext Handle
-> (Handle -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext Handle
isReadableHdl
               AppContext Handle
-> (Handle -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext Handle
isNotEofHdl
               AppContext Handle
-> (Handle -> AppContext ByteString) -> AppContext ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> AppContext ByteString
go
               AppContext ByteString
-> (ByteString -> AppContext ByteString) -> AppContext ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> AppContext ByteString
isNotEmptyL

  where
    go :: Handle -> AppContext ByteString
go Handle
hdl = IO ByteString -> AppContext ByteString
forall a. IO a -> AppContext a
liftIOE (IO ByteString -> AppContext ByteString)
-> IO ByteString -> AppContext ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
BSL.hGet Handle
hdl Int
c


-- |
--
isOpenHdl :: S.Handle -> AppContext S.Handle
isOpenHdl :: Handle -> AppContext Handle
isOpenHdl Handle
rHdl = IO Bool -> StateT AppStores (ExceptT String IO) Bool
forall a. IO a -> AppContext a
liftIOE (Handle -> IO Bool
S.hIsOpen Handle
rHdl) StateT AppStores (ExceptT String IO) Bool
-> (Bool -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True  -> Handle -> AppContext Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
rHdl
  Bool
False -> String -> AppContext Handle
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"invalid HANDLE. not opened."


-- |
--
isReadableHdl :: S.Handle -> AppContext S.Handle
isReadableHdl :: Handle -> AppContext Handle
isReadableHdl Handle
rHdl = IO Bool -> StateT AppStores (ExceptT String IO) Bool
forall a. IO a -> AppContext a
liftIOE (Handle -> IO Bool
S.hIsReadable Handle
rHdl) StateT AppStores (ExceptT String IO) Bool
-> (Bool -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True  -> Handle -> AppContext Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
rHdl
  Bool
False -> String -> AppContext Handle
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"invalid HANDLE. not readable."


-- |
--
isNotEofHdl :: S.Handle -> AppContext S.Handle
isNotEofHdl :: Handle -> AppContext Handle
isNotEofHdl Handle
rHdl = IO Bool -> StateT AppStores (ExceptT String IO) Bool
forall a. IO a -> AppContext a
liftIOE (Handle -> IO Bool
S.hIsEOF Handle
rHdl) StateT AppStores (ExceptT String IO) Bool
-> (Bool -> AppContext Handle) -> AppContext Handle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
False -> Handle -> AppContext Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
rHdl
  Bool
True  -> String -> AppContext Handle
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"invalid HANDLE. eof."


-- |
--
isNotEmpty :: String -> AppContext String
isNotEmpty :: String -> AppContext String
isNotEmpty String
b
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
b = String -> AppContext String
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"empty input."
  | Bool
otherwise = String -> AppContext String
forall (m :: * -> *) a. Monad m => a -> m a
return String
b


-- |
--
isNotEmptyL :: BSL.ByteString -> AppContext BSL.ByteString
isNotEmptyL :: ByteString -> AppContext ByteString
isNotEmptyL ByteString
b
  | ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
BSL.empty = String -> AppContext ByteString
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"empty input."
  | Bool
otherwise = ByteString -> AppContext ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
b


-- |
--
addEvent :: Event -> AppContext ()
addEvent :: Event -> AppContext ()
addEvent Event
evt = do
  MVar [Event]
mvar <- Getting (MVar [Event]) AppStores (MVar [Event])
-> AppStores -> MVar [Event]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (MVar [Event]) AppStores (MVar [Event])
Lens' AppStores (MVar [Event])
eventStoreAppStores (AppStores -> MVar [Event])
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) (MVar [Event])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  [Event]
evts <- IO [Event] -> StateT AppStores (ExceptT String IO) [Event]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Event] -> StateT AppStores (ExceptT String IO) [Event])
-> IO [Event] -> StateT AppStores (ExceptT String IO) [Event]
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> IO [Event]
forall a. MVar a -> IO a
takeMVar MVar [Event]
mvar
  IO () -> AppContext ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> [Event] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar [Event]
mvar ([Event]
evts[Event] -> [Event] -> [Event]
forall a. [a] -> [a] -> [a]
++[Event
evt])


-- |
--
liftIOE :: IO a -> AppContext a
liftIOE :: IO a -> AppContext a
liftIOE IO a
f = IO (Either String a)
-> StateT AppStores (ExceptT String IO) (Either String a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either String a)
forall b. IO b -> IO (Either String b)
go IO a
f) StateT AppStores (ExceptT String IO) (Either String a)
-> (Either String a -> AppContext a) -> AppContext a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String a -> AppContext a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
  where
    go :: IO b -> IO (Either String b)
    go :: IO b -> IO (Either String b)
go IO b
f = IO (Either String b)
-> (SomeException -> IO (Either String b)) -> IO (Either String b)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
E.catchAny (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> IO b -> IO (Either String b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b
f) SomeException -> IO (Either String b)
forall a. SomeException -> IO (Either String a)
errHdl

    errHdl :: E.SomeException -> IO (Either String a)
    errHdl :: SomeException -> IO (Either String a)
errHdl = Either String a -> IO (Either String a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> (SomeException -> Either String a)
-> SomeException
-> IO (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (SomeException -> String) -> SomeException -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show


-- |
--
rstrip :: String -> String
rstrip :: String -> String
rstrip = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.stripEnd (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack


-- |
--
strip :: String -> String
strip :: String -> String
strip = Text -> String
T.unpack (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- |
--
replace :: String -> String -> String -> String
replace :: String -> String -> String -> String
replace String
a String
b String
c = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace (String -> Text
T.pack String
a) (String -> Text
T.pack String
b) (String -> Text
T.pack String
c)

-- |
--
split :: String -> String -> [String]
split :: String -> String -> [String]
split String
a String
b = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack ([Text] -> [String]) -> [Text] -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn (String -> Text
T.pack String
a) (String -> Text
T.pack String
b)

-- |
--
join :: String -> [String] -> String
join :: String -> [String] -> String
join String
a [String]
b = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack String
a) ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
b

-- |
--
startswith :: String -> String -> Bool
startswith :: String -> String -> Bool
startswith String
a String
b = Text -> Text -> Bool
T.isPrefixOf (String -> Text
T.pack String
a) (String -> Text
T.pack String
b)


-- |
--
stdioLogging :: BSL.ByteString -> AppContext ()
stdioLogging :: ByteString -> AppContext ()
stdioLogging ByteString
bs = do
  Maybe String
logFile <- Getting (Maybe String) AppStores (Maybe String)
-> AppStores -> Maybe String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe String) AppStores (Maybe String)
Lens' AppStores (Maybe String)
stdioLogFileAppStores (AppStores -> Maybe String)
-> StateT AppStores (ExceptT String IO) AppStores
-> StateT AppStores (ExceptT String IO) (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT AppStores (ExceptT String IO) AppStores
forall s (m :: * -> *). MonadState s m => m s
get
  Maybe String -> AppContext ()
go Maybe String
logFile

  where
    go :: Maybe FilePath -> AppContext ()
    go :: Maybe String -> AppContext ()
go Maybe String
Nothing  = () -> AppContext ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (Just String
f) = IO () -> AppContext ()
forall a. IO a -> AppContext a
liftIOE (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BSL.appendFile String
f ByteString
bs


-- |
--
stdinLogging :: BSL.ByteString -> AppContext ()
stdinLogging :: ByteString -> AppContext ()
stdinLogging ByteString
bs = do
  ByteString -> AppContext ()
stdioLogging (ByteString -> AppContext ()) -> ByteString -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
str2lbs String
"[ IN]" ByteString -> ByteString -> ByteString
`BSL.append` ByteString
bs ByteString -> ByteString -> ByteString
`BSL.append` String -> ByteString
str2lbs String
"\n"


-- |
--
stdoutLogging :: BSL.ByteString -> AppContext ()
stdoutLogging :: ByteString -> AppContext ()
stdoutLogging ByteString
bs = do
  ByteString -> AppContext ()
stdioLogging (ByteString -> AppContext ()) -> ByteString -> AppContext ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString
str2lbs String
"[OUT]" ByteString -> ByteString -> ByteString
`BSL.append` ByteString
bs ByteString -> ByteString -> ByteString
`BSL.append` String -> ByteString
str2lbs String
"\n"