-- 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

{-# LANGUAGE CPP #-}
module LogView.Process (
    -- * state
    State(..), initial_state, add_msg, state_msgs
    , compile_filter
    -- * process_msg
    , process_msg
    , CatchPattern, global_status_pattern
    , render_status
    , StyledText(..)

    , match_pattern
#ifdef TESTING
    , flatten_ranges, run_formatter, regex_style, style_plain
    , msg_text_regexes
#endif
) where
import qualified Control.Monad.Trans.State as State
import qualified Control.Monad.Trans.Writer as Writer
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Foldable as Foldable
import qualified Data.Functor.Identity as Identity
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Sequence as Sequence
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text.Encoding
import qualified Data.Word as Word

import qualified Util.CallStack as CallStack
import qualified Util.Lists as Lists
import qualified Util.Log as Log
import qualified Util.Regex as Regex

import qualified Derive.Stack as Stack

import           Global


-- * state

data State = State {
    State -> Filter
state_filter :: Filter
    -- | Msgs matching this regex have their matching groups put in the
    -- status line.
    , State -> [CatchPattern]
state_catch_patterns :: [CatchPattern]
    , State -> Status
state_status :: Status
    -- | A cache of the most recent msgs.  When the filter is changed they can
    -- be displayed.  This way memory use is bounded but you can display recent
    -- msgs you missed because of the filter.
    , State -> Seq Msg
state_cached_msgs :: Sequence.Seq Log.Msg
    -- | Last displayed msg, along with the number of times it has been seen.
    -- Used to suppress duplicate msgs.
    , State -> Maybe (Msg, Int)
state_last_displayed :: Maybe (Log.Msg, Int)
    } deriving (Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

initial_state :: Text -> State
initial_state :: Text -> State
initial_state Text
filt = State
    { state_filter :: Filter
state_filter = Text -> Filter
compile_filter Text
filt
    , state_catch_patterns :: [CatchPattern]
state_catch_patterns = []
    , state_status :: Status
state_status = forall k a. Map k a
Map.empty
    , state_cached_msgs :: Seq Msg
state_cached_msgs = forall a. Seq a
Sequence.empty
    , state_last_displayed :: Maybe (Msg, Int)
state_last_displayed = forall a. Maybe a
Nothing
    }

add_msg :: Int -> Log.Msg -> State -> State
add_msg :: Int -> Msg -> State -> State
add_msg Int
history Msg
msg State
state = State
state { state_cached_msgs :: Seq Msg
state_cached_msgs = Seq Msg
seq }
    where seq :: Seq Msg
seq = forall a. Int -> Seq a -> Seq a
Sequence.take Int
history (Msg
msg forall a. a -> Seq a -> Seq a
Sequence.<| State -> Seq Msg
state_cached_msgs State
state)

state_msgs :: State -> [Log.Msg]
state_msgs :: State -> [Msg]
state_msgs = forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Seq Msg
state_cached_msgs

-- ** catch

-- | Transform the status line based on each msg.
type Catch = Log.Msg -> Status -> Status

-- | Extract text from a log msg and put it in 'state_status', via
-- 'catch_regexes'.
type CatchPattern = (Text, Regex.Regex)

-- ** status

type Status = Map Text Text

render_status :: Status -> StyledText
render_status :: Status -> StyledText
render_status Status
status = Formatter -> StyledText
run_formatter forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
List.intersperse (Word8 -> Text -> Formatter
with_style Word8
style_divider Text
" || ")
        (forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Formatter
format_status (forall k a. Map k a -> [(k, a)]
Map.assocs Status
status))

format_status :: (Text, Text) -> Formatter
format_status :: (Text, Text) -> Formatter
format_status (Text
k, Text
v) = do
    Word8 -> Text -> Formatter
with_style Word8
style_emphasis Text
k
    Word8 -> Text -> Formatter
with_style Word8
style_plain Text
": "
    Word8 -> [(Regex, Word8)] -> Text -> Formatter
regex_style Word8
style_plain [(Regex, Word8)]
clickable_braces Text
v

clickable_braces :: [(Regex.Regex, Style)]
clickable_braces :: [(Regex, Word8)]
clickable_braces =
    [ (HasCallStack => String -> Regex
Regex.compileUnsafe String
"\\{.*?\\}", Word8
style_clickable)
    ]

data StyledText = StyledText {
    -- | UTF8-encoded text.
    StyledText -> ByteString
style_text :: B.ByteString
    -- | 'Style' characters, same length as style_text.
    , StyledText -> ByteString
style_style :: B.ByteString
    } deriving (StyledText -> StyledText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StyledText -> StyledText -> Bool
$c/= :: StyledText -> StyledText -> Bool
== :: StyledText -> StyledText -> Bool
$c== :: StyledText -> StyledText -> Bool
Eq, Int -> StyledText -> ShowS
[StyledText] -> ShowS
StyledText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StyledText] -> ShowS
$cshowList :: [StyledText] -> ShowS
show :: StyledText -> String
$cshow :: StyledText -> String
showsPrec :: Int -> StyledText -> ShowS
$cshowsPrec :: Int -> StyledText -> ShowS
Show)

type ProcessM = State.StateT State Identity.Identity

-- | Process an incoming log msg.  If the msg isn't filtered out, returned
-- a colorized version.  Also possibly modify the app state for things like
-- catch and timing.
process_msg :: State -> Log.Msg -> (Maybe StyledText, State)
process_msg :: State -> Msg -> (Maybe StyledText, State)
process_msg State
state Msg
msg = forall {a}. State State a -> (a, State)
run forall a b. (a -> b) -> a -> b
$ do -- suppress_last msg $ do
    Filter
filt <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets State -> Filter
state_filter
    StateT State Identity ()
process_catch
    let styled :: StyledText
styled = Msg -> StyledText
format_msg Msg
msg
    -- I match the filter on the styled output so that the filter is on
    -- the msg as actually displayed.
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Filter -> Msg -> Text -> Bool
eval_filter Filter
filt Msg
msg forall a b. (a -> b) -> a -> b
$
            ByteString -> Text
Text.Encoding.decodeUtf8 (StyledText -> ByteString
style_text StyledText
styled)
        then forall a. a -> Maybe a
Just StyledText
styled else forall a. Maybe a
Nothing
    where
    run :: State State a -> (a, State)
run = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
State.runState State
state
    process_catch :: StateT State Identity ()
process_catch = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify forall a b. (a -> b) -> a -> b
$ \State
st -> State
st
        { state_status :: Status
state_status = Status -> [CatchPattern] -> Status
catch (State -> Status
state_status State
st) (State -> [CatchPattern]
state_catch_patterns State
st) }
    catch :: Status -> [CatchPattern] -> Status
catch Status
status [CatchPattern]
patterns = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
        (\Status
status Msg -> Status -> Status
catch -> Msg -> Status -> Status
catch Msg
msg Status
status) Status
status ([CatchPattern] -> [Msg -> Status -> Status]
catches [CatchPattern]
patterns)

catches :: [CatchPattern] -> [Catch]
catches :: [CatchPattern] -> [Msg -> Status -> Status]
catches [CatchPattern]
patterns =
    [ [CatchPattern] -> Msg -> Status -> Status
catch_regexes [CatchPattern]
patterns
    , Msg -> Status -> Status
catch_start
    ]

-- | Return Nothing if the given msg is the same as the last one.
suppress_last :: Log.Msg -> ProcessM (Maybe a) -> ProcessM (Maybe a)
suppress_last :: forall a. Msg -> ProcessM (Maybe a) -> ProcessM (Maybe a)
suppress_last Msg
msg ProcessM (Maybe a)
process = do
    Maybe (Msg, Int)
last_displayed <- forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets State -> Maybe (Msg, Int)
state_last_displayed
    case Maybe (Msg, Int)
last_displayed of
        Just (Msg
last_msg, Int
times) | Msg -> Msg -> Bool
matches Msg
last_msg Msg
msg -> do
            forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify forall a b. (a -> b) -> a -> b
$ \State
st ->
                State
st { state_last_displayed :: Maybe (Msg, Int)
state_last_displayed = forall a. a -> Maybe a
Just (Msg
msg, Int
timesforall a. Num a => a -> a -> a
+Int
1) }
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Maybe (Msg, Int)
_ -> do
            Maybe a
result <- ProcessM (Maybe a)
process
            forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
result forall a b. (a -> b) -> a -> b
$ \a
_ -> forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify forall a b. (a -> b) -> a -> b
$ \State
st ->
                State
st { state_last_displayed :: Maybe (Msg, Int)
state_last_displayed = forall a. a -> Maybe a
Just (Msg
msg, Int
0) }
            forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
result
    where matches :: Msg -> Msg -> Bool
matches Msg
m1 Msg
m2 = Msg -> Text
Log.msg_text Msg
m1 forall a. Eq a => a -> a -> Bool
== Msg -> Text
Log.msg_text Msg
m2

-- | This searches the log msg text for a regex and puts it in the status bar
-- with the given key string.
--
-- If the regex has no groups, the entire match is used for the value.  If it
-- has one group, that group is used.  If it has two groups, the first group
-- will replace the key.  >2 groups is an error.
--
-- If the value is \"\", then the key is removed.
catch_regexes :: [CatchPattern] -> Catch
catch_regexes :: [CatchPattern] -> Msg -> Status -> Status
catch_regexes [CatchPattern]
patterns Msg
msg = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Status
status
    where
    status :: Status
status = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map ((forall a b. (a -> b) -> a -> b
$ Msg -> Text
Log.msg_text Msg
msg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CatchPattern -> Text -> Status
match_pattern) [CatchPattern]
patterns

-- | The app sends this on startup, so I can clear out any status from the
-- last session.
catch_start :: Catch
catch_start :: Msg -> Status -> Status
catch_start Msg
msg Status
status
    | Msg -> Text
Log.msg_text Msg
msg forall a. Eq a => a -> a -> Bool
== Text
"app starting" = forall k a. Map k a
Map.empty
    | Bool
otherwise = Status
status

-- | This catches msgs emitted by 'Cmd.Cmd.set_global_status'.
global_status_pattern :: CatchPattern
global_status_pattern :: CatchPattern
global_status_pattern =
    (Text
"_", HasCallStack => String -> Regex
Regex.compileUnsafe String
"^global status: (.*?) -- (.*)")

match_pattern :: CatchPattern -> Text -> Map Text Text
match_pattern :: CatchPattern -> Text -> Status
match_pattern (Text
title, Regex
reg) = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, [Text]) -> (Text, Text)
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> Text -> [(Text, [Text])]
Regex.groups Regex
reg
    where
    extract :: (a, [Text]) -> (Text, Text)
extract (a
_, [Text
match]) = (Text
title, Text
match)
    extract (a
_, [Text
match_title, Text
match]) = (Text
match_title, Text
match)
    extract (a, [Text])
_ = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Regex
reg forall a. [a] -> [a] -> [a]
++ String
" has >2 groups"


-- ** filter

-- | Filter language, created by 'compile_filter'.
data Filter = Filter Text (Log.Msg -> Text -> Bool)
instance Show Filter where
    show :: Filter -> String
show (Filter Text
src Msg -> Text -> Bool
_) = String
"Process.compile_filter " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
src

-- | Compile a simple filter language.  A log msg matches if all of the words
-- in the filter occur within its 'Log.msg_text', and none of the words
-- prefixed by @-@ occur.
compile_filter :: Text -> Filter
compile_filter :: Text -> Filter
compile_filter Text
s = Text -> (Msg -> Text -> Bool) -> Filter
Filter Text
s forall {p}. p -> Text -> Bool
pred
    where
    ([Text]
not_has_, [Text]
has) = forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (Text
"-" `Text.isPrefixOf`) (Text -> [Text]
Text.words Text
s)
    not_has :: [Text]
not_has = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Text.drop Int
1) [Text]
not_has_
    pred :: p -> Text -> Bool
pred p
_msg Text
text = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Text -> Text -> Bool
`Text.isInfixOf` Text
text) [Text]
has
        Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`Text.isInfixOf` Text
text) [Text]
not_has)

eval_filter :: Filter -> Log.Msg -> Text -> Bool
eval_filter :: Filter -> Msg -> Text -> Bool
eval_filter (Filter Text
_ Msg -> Text -> Bool
pred) Msg
msg Text
text = Msg -> Text -> Bool
pred Msg
msg Text
text


-- * format_msg

-- | Format and colorize a single Log.Msg.
format_msg :: Log.Msg -> StyledText
format_msg :: Msg -> StyledText
format_msg Msg
msg = Formatter -> StyledText
run_formatter forall a b. (a -> b) -> a -> b
$ do
    let width :: Int
width = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound :: Log.Priority)
    Word8 -> Text -> Formatter
with_style Word8
style_fixed forall a b. (a -> b) -> a -> b
$ Int -> Char -> Text -> Text
Text.justifyLeft Int
width Char
' ' forall a b. (a -> b) -> a -> b
$
        Priority -> Text
prio_stars (Msg -> Priority
Log.msg_priority Msg
msg)
    let style :: Word8
style = if Msg -> Priority
Log.msg_priority Msg
msg forall a. Ord a => a -> a -> Bool
< Priority
Log.Warn
            then Word8
style_plain else Word8
style_warn
    case Msg -> Caller
Log.msg_caller Msg
msg of
        Caller
CallStack.NoCaller -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        caller :: Caller
caller@(CallStack.Caller {}) ->
            Word8 -> Text -> Formatter
with_style Word8
style_filename forall a b. (a -> b) -> a -> b
$ Caller -> Text
CallStack.showCaller Caller
caller forall a. Semigroup a => a -> a -> a
<> Text
" "
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Msg -> Maybe Stack
Log.msg_stack Msg
msg) forall a b. (a -> b) -> a -> b
$ \Stack
stack -> Stack -> Formatter
emit_stack Stack
stack forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Formatter
with_plain Text
" "
    Word8 -> [(Regex, Word8)] -> Text -> Formatter
regex_style Word8
style [(Regex, Word8)]
msg_text_regexes (Msg -> Text
Log.msg_text Msg
msg)
    Text -> Formatter
with_plain Text
"\n"
    where
    prio_stars :: Priority -> Text
prio_stars Priority
Log.Timer = Text
"-"
    prio_stars Priority
prio = Int -> Text -> Text
Text.replicate (forall a. Enum a => a -> Int
fromEnum Priority
prio) Text
"*"

-- | Pair together text along with the magic Style characters.  The Styles
-- should be the same length as the string.
type Formatter = Writer.Writer Builder ()

data Builder = Builder !Builder.Builder !Builder.Builder

instance Semigroup Builder where
    Builder Builder
a1 Builder
b1 <> :: Builder -> Builder -> Builder
<> Builder Builder
a2 Builder
b2 = Builder -> Builder -> Builder
Builder (Builder
a1 forall a. Semigroup a => a -> a -> a
<> Builder
a2) (Builder
b1 forall a. Semigroup a => a -> a -> a
<> Builder
b2)
instance Monoid Builder where
    mempty :: Builder
mempty = Builder -> Builder -> Builder
Builder forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
    mappend :: Builder -> Builder -> Builder
mappend = forall a. Semigroup a => a -> a -> a
(<>)

run_formatter :: Formatter -> StyledText
run_formatter :: Formatter -> StyledText
run_formatter = Builder -> StyledText
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> w
Writer.execWriter
    where
    build :: Builder -> StyledText
build (Builder Builder
text Builder
styles) = ByteString -> ByteString -> StyledText
StyledText (Builder -> ByteString
b Builder
text) (Builder -> ByteString
b Builder
styles)
    b :: Builder -> ByteString
b = ByteString -> ByteString
Lazy.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString

emit_stack :: Stack.Stack -> Formatter
emit_stack :: Stack -> Formatter
emit_stack Stack
stack = do
    if Stack
stack forall a. Eq a => a -> a -> Bool
== Stack
Stack.empty then forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- This likely means the global transform failed.
        else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [UiFrame]
ui_stack then Text -> Formatter
with_plain forall a b. (a -> b) -> a -> b
$
            Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
Text.intercalate Text
" / " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Text
pretty (Stack -> [Frame]
Stack.outermost Stack
stack))
            forall a. Semigroup a => a -> a -> a
<> Text
"]"
        else Word8 -> Text -> Formatter
with_style Word8
style_clickable forall a b. (a -> b) -> a -> b
$
            Text -> [Text] -> Text
Text.intercalate Text
" / " (forall a b. (a -> b) -> [a] -> [b]
map UiFrame -> Text
Stack.log_ui_frame [UiFrame]
ui_stack)
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Stack -> Maybe Text
last_call Stack
stack) forall a b. (a -> b) -> a -> b
$ \Text
call ->
        Text -> Formatter
with_plain forall a b. (a -> b) -> a -> b
$ Text
" " forall a. Semigroup a => a -> a -> a
<> Text
call forall a. Semigroup a => a -> a -> a
<> Text
":"
    where
    ui_stack :: [UiFrame]
ui_stack = Stack -> [UiFrame]
Stack.to_ui Stack
stack
    last_call :: Stack -> Maybe Text
last_call = forall a. [a] -> Maybe a
Lists.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Frame -> Maybe Text
Stack.call_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
Stack.innermost

msg_text_regexes :: [(Regex.Regex, Style)]
msg_text_regexes :: [(Regex, Word8)]
msg_text_regexes =
    (HasCallStack => String -> Regex
Regex.compileUnsafe String
"\\([bvt]id \".*?\"\\)", Word8
style_emphasis)
    forall a. a -> [a] -> [a]
: [(Regex, Word8)]
clickable_braces

regex_style :: Style -> [(Regex.Regex, Style)] -> Text -> Formatter
regex_style :: Word8 -> [(Regex, Word8)] -> Text -> Formatter
regex_style Word8
default_style [(Regex, Word8)]
regex_styles Text
text =
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [Formatter]
emits forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Text -> Formatter
with_style Word8
default_style Text
rest
    where
    (Text
rest, [Formatter]
emits) = forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL Text -> (Int, Word8) -> (Text, Formatter)
emit Text
text [(Int, Word8)]
ranges
    emit :: Text -> (Int, Word8) -> (Text, Formatter)
emit Text
text (Int
i, Word8
style) = (Text
post, Word8 -> Text -> Formatter
with_style Word8
style Text
pre)
        where (Text
pre, Text
post) = Int -> Text -> (Text, Text)
Text.splitAt Int
i Text
text
    ranges :: [(Int, Word8)]
ranges = forall a. a -> [((Int, Int), a)] -> [(Int, a)]
flatten_ranges Word8
default_style
        [ ((Int, Int)
range, Word8
style)
        | (Regex
reg, Word8
style) <- [(Regex, Word8)]
regex_styles
        , ((Int, Int)
range, [(Int, Int)]
_) <- Regex -> Text -> [((Int, Int), [(Int, Int)])]
Regex.groupRanges Regex
reg Text
text
        ]

flatten_ranges :: a -> [((Int, Int), a)] -> [(Int, a)]
flatten_ranges :: forall a. a -> [((Int, Int), a)] -> [(Int, a)]
flatten_ranges a
deflt = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
>Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (Ord a, Num a) => a -> [((a, a), a)] -> (a, [(a, a)])
go Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> k) -> [a] -> [a]
Lists.sortOn forall a b. (a, b) -> a
fst
    where
    go :: a -> [((a, a), a)] -> (a, [(a, a)])
go a
n [] = (a
n, [])
    go a
n (((a
s, a
e), a
style) : [((a, a), a)]
ranges) = (,) (forall a. Ord a => a -> a -> a
max a
last_n a
e) forall a b. (a -> b) -> a -> b
$
        (a
s forall a. Num a => a -> a -> a
- a
n, a
deflt)
        forall a. a -> [a] -> [a]
: (forall a. Ord a => a -> a -> a
min a
e a
next forall a. Num a => a -> a -> a
- a
s, a
style)
        forall a. a -> [a] -> [a]
: [(a, a)]
rest forall a. [a] -> [a] -> [a]
++ if a
last_n forall a. Ord a => a -> a -> Bool
< a
e then [(a
e forall a. Num a => a -> a -> a
- a
last_n, a
style)] else []
        where
        next :: a
next = forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
e (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a. [a] -> Maybe a
Lists.head [((a, a), a)]
ranges)
        (a
last_n, [(a, a)]
rest) = a -> [((a, a), a)] -> (a, [(a, a)])
go a
e [((a, a), a)]
ranges

with_plain :: Text -> Formatter
with_plain :: Text -> Formatter
with_plain = Word8 -> Text -> Formatter
with_style Word8
style_plain

with_style :: Style -> Text -> Formatter
with_style :: Word8 -> Text -> Formatter
with_style Word8
_ Text
text | Text -> Bool
Text.null Text
text = forall (m :: * -> *) a. Monad m => a -> m a
return ()
with_style Word8
style Text
text = forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
Writer.tell forall a b. (a -> b) -> a -> b
$
    Builder -> Builder -> Builder
Builder (ByteString -> Builder
Builder.byteString ByteString
utf8)
        (ByteString -> Builder
Builder.byteString (Int -> Word8 -> ByteString
B.replicate (ByteString -> Int
B.length ByteString
utf8) Word8
style))
    where utf8 :: ByteString
utf8 = Text -> ByteString
Text.Encoding.encodeUtf8 Text
text

type Style = Word.Word8

style_plain, style_warn, style_clickable, style_emphasis, style_divider,
    style_filename :: Style
style_plain :: Word8
style_plain = Char -> Word8
word Char
'A'
style_warn :: Word8
style_warn = Char -> Word8
word Char
'B'
style_clickable :: Word8
style_clickable = Char -> Word8
word Char
'C'
style_emphasis :: Word8
style_emphasis = Char -> Word8
word Char
'D'
style_divider :: Word8
style_divider = Char -> Word8
word Char
'E'
-- I lost calling function name when I switched from hspp to implicit call
-- stacks.
-- style_func_name = word 'F'
style_filename :: Word8
style_filename = Char -> Word8
word Char
'F'
style_fixed :: Word8
style_fixed = Char -> Word8
word Char
'H'

word :: Char -> Word.Word8
word :: Char -> Word8
word = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum