-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | This is a standalone program to monitor the log file.

    It reads lines and streams them to the GUI, which displays them in
    a scrolling box.  Clickable text is surrounded by @{}@s and will be
    highlighted blue in the GUI.  When it's clicked, the GUI sends the tag
    back, much like an HTML href.  For example, stack traces are formatted as
    a REPL cmd that will highlight that location on the score.

    The top line is the status bar, which extracts and remembers bits of
    specially formatted log msgs.  This effectively functions as the app's
    global status bar, since otherwise it has no place for this kind of
    information.  The configuration is 'default_catch_patterns'.

    This also maintains a filter.  The filter is a little language that will
    filter out messages that don't match, documented by
    'Process.compile_filter'.

    In addition, there is a concept of 'Process.CatchPattern's.  These are
    regexes which are matched against msg text.  When one matches, the matched
    groups are kept in a status line.  That way, events reported in the log can
    be collected together.
-}
module LogView.LogView where
import qualified Control.Concurrent as Concurrent
import qualified Control.Concurrent.STM as STM
import qualified Control.Concurrent.STM.TChan as TChan
import qualified Control.Exception as Exception
import qualified Control.Monad.State as State

import qualified Data.ByteString.Char8 as ByteString
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO

import qualified System.Console.GetOpt as GetOpt
import qualified System.Directory as Directory
import qualified System.Environment
import qualified System.Exit
import qualified System.Posix as Posix

import qualified Util.Exceptions as Exceptions
import qualified Util.Fltk as Fltk
import qualified Util.FltkUtil as FltkUtil
import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Processes as Processes

import qualified App.Path as Path
import qualified App.ReplProtocol as ReplProtocol
import qualified LogView.LogViewC as LogViewC
import qualified LogView.Process as Process
import qualified LogView.Tail as Tail

import           Global


-- | I use this file to only start one logview at a time.
pid_file :: FilePath
pid_file :: [Char]
pid_file = [Char]
"log/logview.pid"

-- | Initial contents of the filter field.
initial_filter :: Text
initial_filter :: Text
initial_filter = Text
"**"

initial_size :: (Int, Int)
initial_size :: (Int, Int)
initial_size = (Int
900, Int
300)

-- | Built-in list of catch patterns.
--
-- I wound up having the app emit catch patterns explicitly instead of putting
-- the smarts in logview, so now the only CatchPattern is
-- 'Process.global_status_pattern'.  But it still seems conceivable that
-- someday I may want logview to catch things the app didn't explicitly mean to
-- be caught, so I'll leave this functionality in for now.
default_catch_patterns :: [Process.CatchPattern]
default_catch_patterns :: [CatchPattern]
default_catch_patterns = [CatchPattern
Process.global_status_pattern]

-- | Remember this many log msgs.
default_history :: Int
default_history :: Int
default_history = Int
1000

-- | UI will remember this many bytes.  This is not the same as
-- 'default_history' because the history will remember filtered out msgs, and
-- the UI doesn't bother to preserve msg boundaries so it uses bytes.
default_max_bytes :: Int
default_max_bytes :: Int
default_max_bytes = Int
default_history forall a. Num a => a -> a -> a
* Int
100

data Flag = Help | Seek (Maybe Integer) | Print | History Int | File FilePath
    | Geometry FltkUtil.Geometry
    deriving (Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> [Char]
$cshow :: Flag -> [Char]
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show)

options :: [GetOpt.OptDescr Flag]
options :: [OptDescr Flag]
options =
    [ forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"help"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
Help) [Char]
"display usage"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"seek"] (forall a. (Maybe [Char] -> a) -> [Char] -> ArgDescr a
GetOpt.OptArg (Maybe Integer -> Flag
Seek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Read a => [Char] -> a
read) [Char]
"lines") forall a b. (a -> b) -> a -> b
$
        [Char]
"if given no arg, scan the log file from the beginning, if given an"
        forall a. [a] -> [a] -> [a]
++ [Char]
" arg, scan approximately that many lines from the end (assuming"
        forall a. [a] -> [a] -> [a]
++ [Char]
" the average line is 200 bytes)"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"print"] (forall a. a -> ArgDescr a
GetOpt.NoArg Flag
Print)
        [Char]
"print formatted logs to stdout instead of bringing up the GUI"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"history"]
        (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
GetOpt.ReqArg (Int -> Flag
History forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> a
read) (forall a. Show a => a -> [Char]
show Int
default_history))
        [Char]
"remember this many lines"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
GetOpt.Option [] [[Char]
"file"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
GetOpt.ReqArg [Char] -> Flag
File [Char]
"seq.log")
        [Char]
"read from this file"
    , forall a. (Geometry -> a) -> OptDescr a
FltkUtil.option Geometry -> Flag
Geometry
    ]

type LogChan = TChan.TChan Log.Msg

main :: IO ()
main :: IO ()
main = do
    [[Char]]
args <- IO [[Char]]
System.Environment.getArgs
    ([Flag]
flags, [[Char]]
args) <- case forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
GetOpt.getOpt forall a. ArgOrder a
GetOpt.Permute [OptDescr Flag]
options [[Char]]
args of
        ([Flag]
flags, [[Char]]
args, []) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Flag]
flags, [[Char]]
args)
        ([Flag]
_, [[Char]]
_, [[Char]]
errs) -> forall {b}. [Char] -> IO b
usage forall a b. (a -> b) -> a -> b
$ [Char]
"flag errors:\n" forall a. [a] -> [a] -> [a]
++ forall a. Monoid a => a -> [a] -> a
Lists.join [Char]
", " [[Char]]
errs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
args) forall a b. (a -> b) -> a -> b
$
        forall {b}. [Char] -> IO b
usage ([Char]
"unparsed args: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [[Char]]
args)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag
Help forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags) (forall {b}. [Char] -> IO b
usage [Char]
"usage:")
    forall (m :: * -> *) a.
Monad m =>
m (Maybe a) -> (a -> m ()) -> m ()
whenJustM IO (Maybe ProcessID)
write_pid forall a b. (a -> b) -> a -> b
$ \ProcessID
pid -> do
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"logview already running with pid " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ProcessID
pid
        forall a. IO a
System.Exit.exitSuccess
    [Flag] -> IO ()
logview [Flag]
flags forall a b. IO a -> IO b -> IO a
`Exception.finally` [Char] -> IO ()
Directory.removeFile [Char]
pid_file
    where
    usage :: [Char] -> IO b
usage [Char]
msg = do
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: " forall a. [a] -> [a] -> [a]
++ [Char]
msg
        [Char] -> IO ()
putStrLn [Char]
"usage: logview [ flags ]"
        [Char] -> IO ()
putStr (forall a. [Char] -> [OptDescr a] -> [Char]
GetOpt.usageInfo [Char]
"" [OptDescr Flag]
options)
        forall a. IO a
System.Exit.exitFailure

logview :: [Flag] -> IO ()
logview :: [Flag] -> IO ()
logview [Flag]
flags = do
    let seek :: Maybe Integer
seek = forall a. a -> Maybe a -> a
fromMaybe (forall a. a -> Maybe a
Just Integer
0) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
Lists.last [Maybe Integer
s | Seek Maybe Integer
s <- [Flag]
flags]
        history :: Int
history = forall a. a -> Maybe a -> a
fromMaybe Int
default_history forall a b. (a -> b) -> a -> b
$
            forall a. [a] -> Maybe a
Lists.last [Int
n | History Int
n <- [Flag]
flags]
    [Char]
filename <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO [Char]
Tail.log_filename forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        forall a. [a] -> Maybe a
Lists.last [[Char]
n | File [Char]
n <- [Flag]
flags]
    Handle
hdl <- [Char] -> Maybe Integer -> IO Handle
Tail.open [Char]
filename Maybe Integer
seek
    TChan Msg
log_chan <- forall a. IO (TChan a)
STM.newTChanIO
    Maybe Channel
gui_chan <- if Flag
Print forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
flags then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Channel
Fltk.new_channel
    ThreadId
main_thread <- IO ThreadId
Concurrent.myThreadId
    forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
Concurrent.forkFinally (forall {b}. TChan Msg -> Handle -> IO b
tail_loop TChan Msg
log_chan Handle
hdl) forall a b. (a -> b) -> a -> b
$ \Either SomeException ()
result -> do
        [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"tail loop died: " forall a. [a] -> [a] -> [a]
++ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Show a => a -> [Char]
show (forall a b. a -> b -> a
const [Char]
"no exception")
            (Either SomeException ()
result :: Either Exception.SomeException ())
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ThreadId -> IO ()
Concurrent.killThread ThreadId
main_thread) Channel -> IO ()
Fltk.quit Maybe Channel
gui_chan
    case Maybe Channel
gui_chan of
        Maybe Channel
Nothing -> TChan Msg -> IO ()
print_logs TChan Msg
log_chan
        Just Channel
chan -> Maybe Geometry -> Channel -> TChan Msg -> [Char] -> Int -> IO ()
gui Maybe Geometry
geometry Channel
chan TChan Msg
log_chan [Char]
filename Int
history
            where geometry :: Maybe Geometry
geometry = forall a. [a] -> Maybe a
Lists.head [Geometry
g | Geometry Geometry
g <- [Flag]
flags]
    where
    tail_loop :: TChan Msg -> Handle -> IO b
tail_loop TChan Msg
log_chan Handle
hdl = do
        (Msg
msg, Handle
hdl) <- Handle -> IO (Msg, Handle)
Tail.tail Handle
hdl
        forall a. STM a -> IO a
STM.atomically forall a b. (a -> b) -> a -> b
$ forall a. TChan a -> a -> STM ()
TChan.writeTChan TChan Msg
log_chan Msg
msg
        TChan Msg -> Handle -> IO b
tail_loop TChan Msg
log_chan Handle
hdl

-- | If a logview is already running, return its pid, otherwise write the
-- current pid.
write_pid :: IO (Maybe Posix.ProcessID)
write_pid :: IO (Maybe ProcessID)
write_pid = do
    -- I have to use ByteString.readFile and writeFile to avoid GHC's obnoxious
    -- file locking.
    Maybe ByteString
pid_str <- forall a. IO a -> IO (Maybe a)
Exceptions.ignoreEnoent forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
ByteString.readFile [Char]
pid_file
    Maybe ProcessID
existing <- case ByteString -> Maybe (Int, ByteString)
ByteString.readInt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
pid_str of
        Just (Int
pid_, ByteString
_) -> do
            Maybe [Char]
maybe_cmd <- ProcessID -> IO (Maybe [Char])
Processes.commandName ProcessID
pid
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ([Char]
"logview" `List.isSuffixOf`) Maybe [Char]
maybe_cmd
                then forall a. a -> Maybe a
Just ProcessID
pid else forall a. Maybe a
Nothing
            where pid :: ProcessID
pid = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pid_
        Maybe (Int, ByteString)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ProcessID
existing forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$ do
        ProcessID
pid <- IO ProcessID
Posix.getProcessID
        [Char] -> ByteString -> IO ()
ByteString.writeFile [Char]
pid_file ([Char] -> ByteString
ByteString.pack (forall a. Show a => a -> [Char]
show ProcessID
pid) forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")
    forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ProcessID
existing

gui :: Maybe FltkUtil.Geometry -> Fltk.Channel -> LogChan -> FilePath -> Int
    -> IO ()
gui :: Maybe Geometry -> Channel -> TChan Msg -> [Char] -> Int -> IO ()
gui Maybe Geometry
geometry Channel
chan TChan Msg
log_chan [Char]
filename Int
history = do
    [Char]
filename <- [Char] -> IO [Char]
Directory.canonicalizePath [Char]
filename
    let (Int
x, Int
y, Int
w, Int
h) =
            Int -> Int -> Int -> Int -> Maybe Geometry -> (Int, Int, Int, Int)
FltkUtil.xywh Int
20 Int
20 (forall a b. (a, b) -> a
fst (Int, Int)
initial_size) (forall a b. (a, b) -> b
snd (Int, Int)
initial_size) Maybe Geometry
geometry
    Window
win <- forall a. Fltk a -> IO a
Fltk.run_action forall a b. (a -> b) -> a -> b
$
        Int -> Int -> Int -> Int -> [Char] -> Int -> Fltk Window
LogViewC.create Int
x Int
y Int
w Int
h [Char]
filename Int
default_max_bytes
    forall a. Fltk a -> IO a
Fltk.run_action forall a b. (a -> b) -> a -> b
$ Window -> Text -> Fltk ()
LogViewC.set_filter Window
win Text
initial_filter
    let state :: State
state = (Text -> State
Process.initial_state Text
initial_filter)
            { state_catch_patterns :: [CatchPattern]
Process.state_catch_patterns = [CatchPattern]
default_catch_patterns }
    IO () -> IO ThreadId
Concurrent.forkIO forall a b. (a -> b) -> a -> b
$ Channel -> State -> Int -> TChan Msg -> Window -> IO ()
handle_msgs Channel
chan State
state Int
history TChan Msg
log_chan Window
win
    Channel -> IO ()
Fltk.event_loop Channel
chan

print_logs :: LogChan -> IO ()
print_logs :: TChan Msg -> IO ()
print_logs TChan Msg
log_chan = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$
    Text -> IO ()
Text.IO.putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Text
Log.format_msg
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. STM a -> IO a
STM.atomically (forall a. TChan a -> STM a
TChan.readTChan TChan Msg
log_chan)

data Msg = NewLog Log.Msg | ClickedWord Text | FilterChanged Text
    deriving (Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> [Char]
$cshow :: Msg -> [Char]
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show)

handle_msgs :: Fltk.Channel -> Process.State -> Int -> LogChan
    -> LogViewC.Window -> IO ()
handle_msgs :: Channel -> State -> Int -> TChan Msg -> Window -> IO ()
handle_msgs Channel
chan State
st Int
history TChan Msg
log_chan Window
win = do
    Path.AppDir [Char]
app_dir_ <- IO AppDir
Path.get_app_dir
    let app_dir :: Text
app_dir = [Char] -> Text
txt [Char]
app_dir_ forall a. Semigroup a => a -> a -> a
<> Text
"/"
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT State
st forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
        Msg
ui_msg <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ TChan Msg -> Window -> IO Msg
get_msg TChan Msg
log_chan Window
win
        case Msg
ui_msg of
            NewLog Msg
msg_ -> do
                let msg :: Msg
msg = Text -> Msg -> Msg
strip_paths Text
app_dir Msg
msg_
                forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify (Int -> Msg -> State -> State
Process.add_msg Int
history Msg
msg)
                Channel -> Window -> Msg -> StateT State IO ()
handle_new_msg Channel
chan Window
win Msg
msg
            ClickedWord Text
word -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
handle_clicked_word Text
word
            FilterChanged Text
expr -> do
                -- clear and redisplay msgs with new filter
                forall (m :: * -> *). MonadIO m => Channel -> Fltk () -> m ()
send_action Channel
chan forall a b. (a -> b) -> a -> b
$ Window -> Fltk ()
LogViewC.clear_logs Window
win
                forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify forall a b. (a -> b) -> a -> b
$ \State
st ->
                    State
st { state_filter :: Filter
Process.state_filter = Text -> Filter
Process.compile_filter Text
expr }
                [Msg]
all_msgs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
State.gets (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Msg]
Process.state_msgs)
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Channel -> Window -> Msg -> StateT State IO ()
handle_new_msg Channel
chan Window
win) [Msg]
all_msgs

-- | Internally I use absolute paths, but they're pretty verbose.  So turn
-- them back into relative paths.
strip_paths :: Text -> Log.Msg -> Log.Msg
strip_paths :: Text -> Msg -> Msg
strip_paths Text
dir Msg
msg =
    Msg
msg { msg_text :: Text
Log.msg_text = HasCallStack => Text -> Text -> Text -> Text
Text.replace Text
dir Text
"" forall a b. (a -> b) -> a -> b
$ Msg -> Text
Log.msg_text Msg
msg }

handle_new_msg :: Fltk.Channel -> LogViewC.Window -> Log.Msg
    -> State.StateT Process.State IO ()
handle_new_msg :: Channel -> Window -> Msg -> StateT State IO ()
handle_new_msg Channel
chan Window
win Msg
msg = do
    State
state <- forall s (m :: * -> *). MonadState s m => m s
State.get
    let (Maybe StyledText
styled, State
new_state) = State -> Msg -> (Maybe StyledText, State)
Process.process_msg State
state Msg
msg
    forall s (m :: * -> *). MonadState s m => s -> m ()
State.put State
new_state
    case Maybe StyledText
styled of
        Just (Process.StyledText ByteString
txt ByteString
style) -> forall (m :: * -> *). MonadIO m => Channel -> Fltk () -> m ()
send_action Channel
chan forall a b. (a -> b) -> a -> b
$ do
            Window -> ByteString -> ByteString -> Fltk ()
LogViewC.append_log Window
win ByteString
txt ByteString
style
            -- This is an experimental feature to draw more attention when
            -- there's an interesting log msg.
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Msg -> Priority
Log.msg_priority Msg
msg forall a. Ord a => a -> a -> Bool
>= Priority
Log.Warn) forall a b. (a -> b) -> a -> b
$
                Window -> Fltk ()
LogViewC.bring_to_front Window
win
        Maybe StyledText
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    let new_status :: Status
new_status = State -> Status
Process.state_status State
new_state
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (State -> Status
Process.state_status State
state forall a. Eq a => a -> a -> Bool
/= Status
new_status) forall a b. (a -> b) -> a -> b
$ do
        let (Process.StyledText ByteString
status ByteString
style) = Status -> StyledText
Process.render_status Status
new_status
        forall (m :: * -> *). MonadIO m => Channel -> Fltk () -> m ()
send_action Channel
chan forall a b. (a -> b) -> a -> b
$ Window -> ByteString -> ByteString -> Fltk ()
LogViewC.set_status Window
win ByteString
status ByteString
style
        forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
State.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st { state_status :: Status
Process.state_status = Status
new_status }

handle_clicked_word :: Text -> IO ()
handle_clicked_word :: Text -> IO ()
handle_clicked_word Text
word
    | Text
"{" Text -> Text -> Bool
`Text.isPrefixOf` Text
word Bool -> Bool -> Bool
&& Text
"}" Text -> Text -> Bool
`Text.isSuffixOf` Text
word =
        Text -> IO ()
send_to_seq (Int -> Text -> Text
Text.drop Int
1 (Int -> Text -> Text
Text.dropEnd Int
1 Text
word))
    | Bool
otherwise = [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"logview: unknown clicked word: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
word

send_action :: State.MonadIO m => Fltk.Channel -> Fltk.Fltk () -> m ()
send_action :: forall (m :: * -> *). MonadIO m => Channel -> Fltk () -> m ()
send_action Channel
chan = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Fltk () -> IO ()
Fltk.action Channel
chan

send_to_seq :: Text -> IO ()
send_to_seq :: Text -> IO ()
send_to_seq Text
cmd = do
    Text
response <- Text -> IO Text
ReplProtocol.query_cmd_simple Text
cmd
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
Text.null Text
response) forall a b. (a -> b) -> a -> b
$
        Text -> IO ()
Text.IO.putStrLn forall a b. (a -> b) -> a -> b
$ Text
"response: " forall a. Semigroup a => a -> a -> a
<> Text
response

get_msg :: LogChan -> LogViewC.Window -> IO Msg
get_msg :: TChan Msg -> Window -> IO Msg
get_msg TChan Msg
log_chan Window
win = forall a. STM a -> IO a
STM.atomically forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Msg -> Msg
NewLog (forall a. TChan a -> STM a
STM.readTChan TChan Msg
log_chan)
    forall a. STM a -> STM a -> STM a
`STM.orElse` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Msg MsgType -> Msg
parse_ui_msg (forall a. Window a -> STM (Msg a)
Fltk.read_msg Window
win)

parse_ui_msg :: Fltk.Msg LogViewC.MsgType -> Msg
parse_ui_msg :: Msg MsgType -> Msg
parse_ui_msg (Fltk.Msg MsgType
typ Text
s) = case MsgType
typ of
    MsgType
LogViewC.Click -> Text -> Msg
ClickedWord Text
s
    MsgType
LogViewC.Command -> Text -> Msg
FilterChanged Text
s
    LogViewC.Unknown CInt
n -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"unknown msg type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CInt
n