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
data FlattenedContent =
FText Text
| FSpace
| FUser Text
| FChannel Text
| FEmoji Text
| FEditSentinel Bool
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)
data FlattenedInline =
FlattenedInline { FlattenedInline -> FlattenedContent
fiValue :: FlattenedContent
, FlattenedInline -> [InlineStyle]
fiStyles :: [InlineStyle]
, FlattenedInline -> Maybe URL
fiURL :: Maybe URL
}
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)
data FlattenedValue =
SingleInline FlattenedInline
| NonBreaking (Seq (Seq FlattenedValue))
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)
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
data FlattenState =
FlattenState { FlattenState -> Seq (Seq FlattenedValue)
fsCompletedLines :: Seq (Seq FlattenedValue)
, FlattenState -> Seq FlattenedValue
fsCurLine :: Seq FlattenedValue
}
data FlattenEnv =
FlattenEnv { FlattenEnv -> [InlineStyle]
flattenStyles :: [InlineStyle]
, FlattenEnv -> Maybe URL
flattenURL :: Maybe URL
, FlattenEnv -> HighlightSet
flattenHighlightSet :: HighlightSet
}
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 })
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
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) }
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
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