-- | This module implements a "flattening" pass over RichText 'Inline'
-- values. This means that a tree structure such as
--
-- @
--   EStrong
--     [ EStrikethrough
--       [ EText "inside"
--       ]
--     , EText "outside"
--     ]
-- @
--
-- will be converted into a "flat" representation without a tree
-- structure so that the style information encoded in the tree is
-- available at each node:
--
-- @
--   [
--     [ SingleInline (FlattenedInline (FText "inside") [Strong, Strikethrough] Nothing
--     , SingleInline (FlattenedInline (FText "outside") [Strong] Nothing
--     ]
--   ]
-- @
--
-- The outer sequence is a sequence of lines (since inline lists can
-- introduce line breaks). Each inner sequence is a single line.
-- Each 'SingleInline' can be rendered as-is; if a 'NonBreaking' is
-- encountered, that group of inlines should be treated as a unit for
-- the purposes of line-wrapping (to happen in the Wrap module). The
-- above representation example shows how the tree path including the
-- 'EStrong' and 'EStrikethrough' nodes is flattened into a list of
-- styles to accompany each inline value. This makes it trivial to carry
-- that style information along with each node during line-wrapping
-- rather than needing to deal with the tree structure.
module Matterhorn.Draw.RichText.Flatten
  ( FlattenedContent(..)
  , FlattenedInline(..)
  , InlineStyle(..)
  , FlattenedValue(..)
  , flattenInlineSeq
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Control.Monad.Reader
import           Control.Monad.State
import           Data.List ( nub )
import qualified Data.Sequence as Seq
import           Data.Sequence ( ViewL(..)
                               , ViewR(..)
                               , (<|)
                               , (|>)
                               )
import qualified Data.Set as Set
import qualified Data.Text as T

import           Matterhorn.Constants ( normalChannelSigil, userSigil )
import           Matterhorn.Types ( HighlightSet(..) )
import           Matterhorn.Types.RichText


-- | A piece of text in a sequence of flattened RichText elements. This
-- type represents the lowest-level kind of data that we can get from a
-- rich text document.
data FlattenedContent =
    FText Text
    -- ^ Some text
    | FSpace
    -- ^ A space
    | FUser Text
    -- ^ A user reference
    | FChannel Text
    -- ^ A channel reference
    | FEmoji Text
    -- ^ An emoji
    | FEditSentinel Bool
    -- ^ An "edited" marking
    deriving (FlattenedContent -> FlattenedContent -> Bool
(FlattenedContent -> FlattenedContent -> Bool)
-> (FlattenedContent -> FlattenedContent -> Bool)
-> Eq FlattenedContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlattenedContent -> FlattenedContent -> Bool
$c/= :: FlattenedContent -> FlattenedContent -> Bool
== :: FlattenedContent -> FlattenedContent -> Bool
$c== :: FlattenedContent -> FlattenedContent -> Bool
Eq, Int -> FlattenedContent -> ShowS
[FlattenedContent] -> ShowS
FlattenedContent -> String
(Int -> FlattenedContent -> ShowS)
-> (FlattenedContent -> String)
-> ([FlattenedContent] -> ShowS)
-> Show FlattenedContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlattenedContent] -> ShowS
$cshowList :: [FlattenedContent] -> ShowS
show :: FlattenedContent -> String
$cshow :: FlattenedContent -> String
showsPrec :: Int -> FlattenedContent -> ShowS
$cshowsPrec :: Int -> FlattenedContent -> ShowS
Show)

-- | A flattened inline value.
data FlattenedInline =
    FlattenedInline { FlattenedInline -> FlattenedContent
fiValue :: FlattenedContent
                    -- ^ The content of the value.
                    , FlattenedInline -> [InlineStyle]
fiStyles :: [InlineStyle]
                    -- ^ The styles that should be applied to this
                    -- value.
                    , FlattenedInline -> Maybe URL
fiURL :: Maybe URL
                    -- ^ If present, the URL to which we should
                    -- hyperlink this value.
                    }
                    deriving (Int -> FlattenedInline -> ShowS
[FlattenedInline] -> ShowS
FlattenedInline -> String
(Int -> FlattenedInline -> ShowS)
-> (FlattenedInline -> String)
-> ([FlattenedInline] -> ShowS)
-> Show FlattenedInline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlattenedInline] -> ShowS
$cshowList :: [FlattenedInline] -> ShowS
show :: FlattenedInline -> String
$cshow :: FlattenedInline -> String
showsPrec :: Int -> FlattenedInline -> ShowS
$cshowsPrec :: Int -> FlattenedInline -> ShowS
Show)

-- | A flattened value.
data FlattenedValue =
    SingleInline FlattenedInline
    -- ^ A single flattened value
    | NonBreaking (Seq (Seq FlattenedValue))
    -- ^ A sequence of flattened values that MUST be kept together and
    -- never broken up by line-wrapping
    deriving (Int -> FlattenedValue -> ShowS
[FlattenedValue] -> ShowS
FlattenedValue -> String
(Int -> FlattenedValue -> ShowS)
-> (FlattenedValue -> String)
-> ([FlattenedValue] -> ShowS)
-> Show FlattenedValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlattenedValue] -> ShowS
$cshowList :: [FlattenedValue] -> ShowS
show :: FlattenedValue -> String
$cshow :: FlattenedValue -> String
showsPrec :: Int -> FlattenedValue -> ShowS
$cshowsPrec :: Int -> FlattenedValue -> ShowS
Show)

-- | The visual styles of inline values.
data InlineStyle =
    Strong
    | Emph
    | Strikethrough
    | Code
    | Permalink
    deriving (InlineStyle -> InlineStyle -> Bool
(InlineStyle -> InlineStyle -> Bool)
-> (InlineStyle -> InlineStyle -> Bool) -> Eq InlineStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineStyle -> InlineStyle -> Bool
$c/= :: InlineStyle -> InlineStyle -> Bool
== :: InlineStyle -> InlineStyle -> Bool
$c== :: InlineStyle -> InlineStyle -> Bool
Eq, Int -> InlineStyle -> ShowS
[InlineStyle] -> ShowS
InlineStyle -> String
(Int -> InlineStyle -> ShowS)
-> (InlineStyle -> String)
-> ([InlineStyle] -> ShowS)
-> Show InlineStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineStyle] -> ShowS
$cshowList :: [InlineStyle] -> ShowS
show :: InlineStyle -> String
$cshow :: InlineStyle -> String
showsPrec :: Int -> InlineStyle -> ShowS
$cshowsPrec :: Int -> InlineStyle -> ShowS
Show)

type FlattenM a = ReaderT FlattenEnv (State FlattenState) a

-- | The flatten monad state
data FlattenState =
    FlattenState { FlattenState -> Seq (Seq FlattenedValue)
fsCompletedLines :: Seq (Seq FlattenedValue)
                 -- ^ The lines that we have accumulated so far in the
                 -- flattening process
                 , FlattenState -> Seq FlattenedValue
fsCurLine :: Seq FlattenedValue
                 -- ^ The current line we are accumulating in the
                 -- flattening process
                 }

-- | The flatten monad environment
data FlattenEnv =
    FlattenEnv { FlattenEnv -> [InlineStyle]
flattenStyles :: [InlineStyle]
               -- ^ The styles that should apply to the current value
               -- being flattened
               , FlattenEnv -> Maybe URL
flattenURL :: Maybe URL
               -- ^ The hyperlink URL, if any, that should be applied to
               -- the current value being flattened
               , FlattenEnv -> HighlightSet
flattenHighlightSet :: HighlightSet
               -- ^ The highlight set to use to check for valid user or
               -- channel references
               }

-- | Given a sequence of inlines, flatten it into a list of lines of
-- flattened values.
--
-- The flattening process also validates user and channel references
-- against a 'HighlightSet'. For example, if an 'EUser' node is found,
-- its username argument is looked up in the 'HighlightSet'. If the
-- username is found, the 'EUser' node is preserved as an 'FUser' node.
-- Otherwise it is rewritten as an 'FText' node so that the username
-- does not get highlighted. Channel references ('EChannel') are handled
-- similarly.
flattenInlineSeq :: HighlightSet -> Inlines -> Seq (Seq FlattenedValue)
flattenInlineSeq :: HighlightSet -> Inlines -> Seq (Seq FlattenedValue)
flattenInlineSeq HighlightSet
hs Inlines
is =
    FlattenEnv -> Inlines -> Seq (Seq FlattenedValue)
flattenInlineSeq' FlattenEnv
initialEnv Inlines
is
    where
        initialEnv :: FlattenEnv
initialEnv = FlattenEnv :: [InlineStyle] -> Maybe URL -> HighlightSet -> FlattenEnv
FlattenEnv { flattenStyles :: [InlineStyle]
flattenStyles = []
                                , flattenURL :: Maybe URL
flattenURL = Maybe URL
forall a. Maybe a
Nothing
                                , flattenHighlightSet :: HighlightSet
flattenHighlightSet = HighlightSet
hs
                                }

flattenInlineSeq' :: FlattenEnv -> Inlines -> Seq (Seq FlattenedValue)
flattenInlineSeq' :: FlattenEnv -> Inlines -> Seq (Seq FlattenedValue)
flattenInlineSeq' FlattenEnv
env Inlines
is =
    FlattenState -> Seq (Seq FlattenedValue)
fsCompletedLines (FlattenState -> Seq (Seq FlattenedValue))
-> FlattenState -> Seq (Seq FlattenedValue)
forall a b. (a -> b) -> a -> b
$ State FlattenState () -> FlattenState -> FlattenState
forall s a. State s a -> s -> s
execState State FlattenState ()
stBody FlattenState
initialState
    where
        initialState :: FlattenState
initialState = Seq (Seq FlattenedValue) -> Seq FlattenedValue -> FlattenState
FlattenState Seq (Seq FlattenedValue)
forall a. Monoid a => a
mempty Seq FlattenedValue
forall a. Monoid a => a
mempty
        stBody :: State FlattenState ()
stBody = ReaderT FlattenEnv (State FlattenState) ()
-> FlattenEnv -> State FlattenState ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT FlattenEnv (State FlattenState) ()
body FlattenEnv
env
        body :: ReaderT FlattenEnv (State FlattenState) ()
body = do
            (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
is
            ReaderT FlattenEnv (State FlattenState) ()
pushFLine

withInlineStyle :: InlineStyle -> FlattenM () -> FlattenM ()
withInlineStyle :: InlineStyle
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withInlineStyle InlineStyle
s =
    (FlattenEnv -> FlattenEnv)
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\FlattenEnv
e -> FlattenEnv
e { flattenStyles :: [InlineStyle]
flattenStyles = [InlineStyle] -> [InlineStyle]
forall a. Eq a => [a] -> [a]
nub (InlineStyle
s InlineStyle -> [InlineStyle] -> [InlineStyle]
forall a. a -> [a] -> [a]
: FlattenEnv -> [InlineStyle]
flattenStyles FlattenEnv
e) })

withHyperlink :: URL -> FlattenM () -> FlattenM ()
withHyperlink :: URL
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withHyperlink URL
u = (FlattenEnv -> FlattenEnv)
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\FlattenEnv
e -> FlattenEnv
e { flattenURL :: Maybe URL
flattenURL = URL -> Maybe URL
forall a. a -> Maybe a
Just URL
u })

-- | Push a FlattenedContent value onto the current line.
pushFC :: FlattenedContent -> FlattenM ()
pushFC :: FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC FlattenedContent
v = do
    FlattenEnv
env <- ReaderT FlattenEnv (State FlattenState) FlattenEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
    let styles :: [InlineStyle]
styles = FlattenEnv -> [InlineStyle]
flattenStyles FlattenEnv
env
        mUrl :: Maybe URL
mUrl = FlattenEnv -> Maybe URL
flattenURL FlattenEnv
env
        fi :: FlattenedInline
fi = FlattenedInline :: FlattenedContent -> [InlineStyle] -> Maybe URL -> FlattenedInline
FlattenedInline { fiValue :: FlattenedContent
fiValue = FlattenedContent
v
                             , fiStyles :: [InlineStyle]
fiStyles = [InlineStyle]
styles
                             , fiURL :: Maybe URL
fiURL = Maybe URL
mUrl
                             }
    FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ()
pushFV (FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ())
-> FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ FlattenedInline -> FlattenedValue
SingleInline FlattenedInline
fi

-- | Push a FlattenedValue onto the current line.
pushFV :: FlattenedValue -> FlattenM ()
pushFV :: FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ()
pushFV FlattenedValue
fv = State FlattenState () -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State FlattenState ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> State FlattenState ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (FlattenState -> FlattenState) -> State FlattenState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FlattenState -> FlattenState) -> State FlattenState ())
-> (FlattenState -> FlattenState) -> State FlattenState ()
forall a b. (a -> b) -> a -> b
$ \FlattenState
s -> FlattenState
s { fsCurLine :: Seq FlattenedValue
fsCurLine = FlattenedValue -> Seq FlattenedValue -> Seq FlattenedValue
appendFV FlattenedValue
fv (FlattenState -> Seq FlattenedValue
fsCurLine FlattenState
s) }

-- | Append the value to the sequence.
--
-- If the both the value to append AND the sequence's last value are
-- both text nodes, AND if those nodes both have the same style and URL
-- metadata, then merge them into one text node. This keeps adjacent
-- non-whitespace text together as one logical token (e.g. "(foo" rather
-- than "(" followed by "foo") to avoid undesirable line break points in
-- the wrapping process.
appendFV :: FlattenedValue -> Seq FlattenedValue -> Seq FlattenedValue
appendFV :: FlattenedValue -> Seq FlattenedValue -> Seq FlattenedValue
appendFV FlattenedValue
v Seq FlattenedValue
line =
    case (Seq FlattenedValue -> ViewR FlattenedValue
forall a. Seq a -> ViewR a
Seq.viewr Seq FlattenedValue
line, FlattenedValue
v) of
        (Seq FlattenedValue
h :> SingleInline FlattenedInline
a, SingleInline FlattenedInline
b) ->
            case (FlattenedInline -> FlattenedContent
fiValue FlattenedInline
a, FlattenedInline -> FlattenedContent
fiValue FlattenedInline
b) of
                (FText Text
aT, FText Text
bT) ->
                    if FlattenedInline -> [InlineStyle]
fiStyles FlattenedInline
a [InlineStyle] -> [InlineStyle] -> Bool
forall a. Eq a => a -> a -> Bool
== FlattenedInline -> [InlineStyle]
fiStyles FlattenedInline
b Bool -> Bool -> Bool
&& FlattenedInline -> Maybe URL
fiURL FlattenedInline
a Maybe URL -> Maybe URL -> Bool
forall a. Eq a => a -> a -> Bool
== FlattenedInline -> Maybe URL
fiURL FlattenedInline
b
                    then Seq FlattenedValue
h Seq FlattenedValue -> FlattenedValue -> Seq FlattenedValue
forall a. Seq a -> a -> Seq a
|> FlattenedInline -> FlattenedValue
SingleInline (FlattenedContent -> [InlineStyle] -> Maybe URL -> FlattenedInline
FlattenedInline (Text -> FlattenedContent
FText (Text -> FlattenedContent) -> Text -> FlattenedContent
forall a b. (a -> b) -> a -> b
$ Text
aT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bT)
                                                            (FlattenedInline -> [InlineStyle]
fiStyles FlattenedInline
a)
                                                            (FlattenedInline -> Maybe URL
fiURL FlattenedInline
a))
                    else Seq FlattenedValue
line Seq FlattenedValue -> FlattenedValue -> Seq FlattenedValue
forall a. Seq a -> a -> Seq a
|> FlattenedValue
v
                (FlattenedContent, FlattenedContent)
_ -> Seq FlattenedValue
line Seq FlattenedValue -> FlattenedValue -> Seq FlattenedValue
forall a. Seq a -> a -> Seq a
|> FlattenedValue
v
        (ViewR FlattenedValue, FlattenedValue)
_ -> Seq FlattenedValue
line Seq FlattenedValue -> FlattenedValue -> Seq FlattenedValue
forall a. Seq a -> a -> Seq a
|> FlattenedValue
v

-- | Push the current line onto the finished lines list and start a new
-- line.
pushFLine :: FlattenM ()
pushFLine :: ReaderT FlattenEnv (State FlattenState) ()
pushFLine =
    State FlattenState () -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State FlattenState ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> State FlattenState ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (FlattenState -> FlattenState) -> State FlattenState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FlattenState -> FlattenState) -> State FlattenState ())
-> (FlattenState -> FlattenState) -> State FlattenState ()
forall a b. (a -> b) -> a -> b
$ \FlattenState
s -> FlattenState
s { fsCompletedLines :: Seq (Seq FlattenedValue)
fsCompletedLines = FlattenState -> Seq (Seq FlattenedValue)
fsCompletedLines FlattenState
s Seq (Seq FlattenedValue)
-> Seq FlattenedValue -> Seq (Seq FlattenedValue)
forall a. Seq a -> a -> Seq a
|> FlattenState -> Seq FlattenedValue
fsCurLine FlattenState
s
                            , fsCurLine :: Seq FlattenedValue
fsCurLine = Seq FlattenedValue
forall a. Monoid a => a
mempty
                            }

isKnownUser :: T.Text -> FlattenM Bool
isKnownUser :: Text -> FlattenM Bool
isKnownUser Text
u = do
    HighlightSet
hSet <- (FlattenEnv -> HighlightSet)
-> ReaderT FlattenEnv (State FlattenState) HighlightSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks FlattenEnv -> HighlightSet
flattenHighlightSet
    let uSet :: Set Text
uSet = HighlightSet -> Set Text
hUserSet HighlightSet
hSet
    Bool -> FlattenM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> FlattenM Bool) -> Bool -> FlattenM Bool
forall a b. (a -> b) -> a -> b
$ Text
u Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
uSet

isKnownChannel :: T.Text -> FlattenM Bool
isKnownChannel :: Text -> FlattenM Bool
isKnownChannel Text
c = do
    HighlightSet
hSet <- (FlattenEnv -> HighlightSet)
-> ReaderT FlattenEnv (State FlattenState) HighlightSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks FlattenEnv -> HighlightSet
flattenHighlightSet
    let cSet :: Set Text
cSet = HighlightSet -> Set Text
hChannelSet HighlightSet
hSet
    Bool -> FlattenM Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> FlattenM Bool) -> Bool -> FlattenM Bool
forall a b. (a -> b) -> a -> b
$ Text
c Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Text
cSet

flatten :: Inline -> FlattenM ()
flatten :: Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten Inline
i =
    case Inline
i of
        EUser Text
u -> do
            Bool
known <- Text -> FlattenM Bool
isKnownUser Text
u
            if Bool
known then FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (Text -> FlattenedContent
FUser Text
u)
                     else FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (Text -> FlattenedContent
FText (Text -> FlattenedContent) -> Text -> FlattenedContent
forall a b. (a -> b) -> a -> b
$ Text
userSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u)
        EChannel Text
c -> do
            Bool
known <- Text -> FlattenM Bool
isKnownChannel Text
c
            if Bool
known then FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (Text -> FlattenedContent
FChannel Text
c)
                     else FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (Text -> FlattenedContent
FText (Text -> FlattenedContent) -> Text -> FlattenedContent
forall a b. (a -> b) -> a -> b
$ Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c)

        ENonBreaking Inlines
is -> do
            FlattenEnv
env <- ReaderT FlattenEnv (State FlattenState) FlattenEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
            FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ()
pushFV (FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ())
-> FlattenedValue -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Seq (Seq FlattenedValue) -> FlattenedValue
NonBreaking (Seq (Seq FlattenedValue) -> FlattenedValue)
-> Seq (Seq FlattenedValue) -> FlattenedValue
forall a b. (a -> b) -> a -> b
$ FlattenEnv -> Inlines -> Seq (Seq FlattenedValue)
flattenInlineSeq' FlattenEnv
env Inlines
is)

        Inline
ESoftBreak                  -> ReaderT FlattenEnv (State FlattenState) ()
pushFLine
        Inline
ELineBreak                  -> ReaderT FlattenEnv (State FlattenState) ()
pushFLine

        EText Text
t                     -> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ())
-> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedContent
FText Text
t
        Inline
ESpace                      -> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC FlattenedContent
FSpace
        ERawHtml Text
h                  -> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ())
-> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedContent
FText Text
h
        EEmoji Text
e                    -> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ())
-> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedContent
FEmoji Text
e
        EEditSentinel Bool
r             -> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
pushFC (FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ())
-> FlattenedContent -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Bool -> FlattenedContent
FEditSentinel Bool
r

        EEmph Inlines
es                    -> InlineStyle
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withInlineStyle InlineStyle
Emph (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
es
        EStrikethrough Inlines
es           -> InlineStyle
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withInlineStyle InlineStyle
Strikethrough (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
es
        EStrong Inlines
es                  -> InlineStyle
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withInlineStyle InlineStyle
Strong (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
es
        ECode Inlines
es                    -> InlineStyle
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withInlineStyle InlineStyle
Code (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines Inlines
es

        EPermalink TeamURLName
_ PostId
_ Maybe Inlines
mLabel ->
            let label' :: Inlines
label' = Inlines -> Maybe Inlines -> Inlines
forall a. a -> Maybe a -> a
fromMaybe (Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Seq Inline
forall a. [a] -> Seq a
Seq.fromList [Text -> Inline
EText Text
"post", Inline
ESpace, Text -> Inline
EText Text
"link"])
                                   Maybe Inlines
mLabel
            in InlineStyle
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withInlineStyle InlineStyle
Permalink (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines (Inlines -> Seq Inline) -> Inlines -> Seq Inline
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
decorateLinkLabel Inlines
label'

        EHyperlink URL
u label :: Inlines
label@(Inlines Seq Inline
ls) ->
            let label' :: Inlines
label' = if Seq Inline -> Bool
forall a. Seq a -> Bool
Seq.null Seq Inline
ls
                         then Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Seq Inline
forall a. a -> Seq a
Seq.singleton (Inline -> Seq Inline) -> Inline -> Seq Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
EText (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ URL -> Text
unURL URL
u
                         else Inlines
label
            in URL
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withHyperlink URL
u (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines (Inlines -> Seq Inline) -> Inlines -> Seq Inline
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
decorateLinkLabel Inlines
label'

        EImage URL
u label :: Inlines
label@(Inlines Seq Inline
ls) ->
            let label' :: Inlines
label' = if Seq Inline -> Bool
forall a. Seq a -> Bool
Seq.null Seq Inline
ls
                         then Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Inline -> Seq Inline
forall a. a -> Seq a
Seq.singleton (Inline -> Seq Inline) -> Inline -> Seq Inline
forall a b. (a -> b) -> a -> b
$ Text -> Inline
EText (Text -> Inline) -> Text -> Inline
forall a b. (a -> b) -> a -> b
$ URL -> Text
unURL URL
u
                         else Inlines
label
            in URL
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
withHyperlink URL
u (ReaderT FlattenEnv (State FlattenState) ()
 -> ReaderT FlattenEnv (State FlattenState) ())
-> ReaderT FlattenEnv (State FlattenState) ()
-> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ (Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Inline -> ReaderT FlattenEnv (State FlattenState) ()
flatten (Seq Inline -> ReaderT FlattenEnv (State FlattenState) ())
-> Seq Inline -> ReaderT FlattenEnv (State FlattenState) ()
forall a b. (a -> b) -> a -> b
$ Inlines -> Seq Inline
unInlines (Inlines -> Seq Inline) -> Inlines -> Seq Inline
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
decorateLinkLabel Inlines
label'

linkOpenBracket :: Inline
linkOpenBracket :: Inline
linkOpenBracket = Text -> Inline
EText Text
"<"

linkCloseBracket :: Inline
linkCloseBracket :: Inline
linkCloseBracket = Text -> Inline
EText Text
">"

addOpenBracket :: Inlines -> Inlines
addOpenBracket :: Inlines -> Inlines
addOpenBracket (Inlines Seq Inline
l) =
    case Seq Inline -> ViewL Inline
forall a. Seq a -> ViewL a
Seq.viewl Seq Inline
l of
        ViewL Inline
EmptyL -> Seq Inline -> Inlines
Inlines Seq Inline
l
        Inline
h :< Seq Inline
t ->
            let h' :: Inline
h' = Inlines -> Inline
ENonBreaking (Inlines -> Inline) -> Inlines -> Inline
forall a b. (a -> b) -> a -> b
$ Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Seq Inline
forall a. [a] -> Seq a
Seq.fromList [Inline
linkOpenBracket, Inline
h]
            in Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Inline
h' Inline -> Seq Inline -> Seq Inline
forall a. a -> Seq a -> Seq a
<| Seq Inline
t

addCloseBracket :: Inlines -> Inlines
addCloseBracket :: Inlines -> Inlines
addCloseBracket (Inlines Seq Inline
l) =
    case Seq Inline -> ViewR Inline
forall a. Seq a -> ViewR a
Seq.viewr Seq Inline
l of
        ViewR Inline
EmptyR -> Seq Inline -> Inlines
Inlines Seq Inline
l
        Seq Inline
h :> Inline
t ->
            let t' :: Inline
t' = Inlines -> Inline
ENonBreaking (Inlines -> Inline) -> Inlines -> Inline
forall a b. (a -> b) -> a -> b
$ Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ [Inline] -> Seq Inline
forall a. [a] -> Seq a
Seq.fromList [Inline
t, Inline
linkCloseBracket]
            in Seq Inline -> Inlines
Inlines (Seq Inline -> Inlines) -> Seq Inline -> Inlines
forall a b. (a -> b) -> a -> b
$ Seq Inline
h Seq Inline -> Inline -> Seq Inline
forall a. Seq a -> a -> Seq a
|> Inline
t'

decorateLinkLabel :: Inlines -> Inlines
decorateLinkLabel :: Inlines -> Inlines
decorateLinkLabel = Inlines -> Inlines
addOpenBracket (Inlines -> Inlines) -> (Inlines -> Inlines) -> Inlines -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Inlines -> Inlines
addCloseBracket