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 )
import Matterhorn.Types ( HighlightSet(..), SemEq(..), addUserSigil )
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
$c== :: FlattenedContent -> FlattenedContent -> Bool
== :: FlattenedContent -> FlattenedContent -> Bool
$c/= :: FlattenedContent -> FlattenedContent -> Bool
/= :: 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
$cshowsPrec :: Int -> FlattenedContent -> ShowS
showsPrec :: Int -> FlattenedContent -> ShowS
$cshow :: FlattenedContent -> String
show :: FlattenedContent -> String
$cshowList :: [FlattenedContent] -> ShowS
showList :: [FlattenedContent] -> ShowS
Show)
data FlattenedInline a =
FlattenedInline { forall a. FlattenedInline a -> FlattenedContent
fiValue :: FlattenedContent
, forall a. FlattenedInline a -> [InlineStyle]
fiStyles :: [InlineStyle]
, forall a. FlattenedInline a -> Maybe URL
fiURL :: Maybe URL
, forall a. FlattenedInline a -> Maybe a
fiName :: Maybe a
}
deriving (Int -> FlattenedInline a -> ShowS
[FlattenedInline a] -> ShowS
FlattenedInline a -> String
(Int -> FlattenedInline a -> ShowS)
-> (FlattenedInline a -> String)
-> ([FlattenedInline a] -> ShowS)
-> Show (FlattenedInline a)
forall a. Show a => Int -> FlattenedInline a -> ShowS
forall a. Show a => [FlattenedInline a] -> ShowS
forall a. Show a => FlattenedInline a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FlattenedInline a -> ShowS
showsPrec :: Int -> FlattenedInline a -> ShowS
$cshow :: forall a. Show a => FlattenedInline a -> String
show :: FlattenedInline a -> String
$cshowList :: forall a. Show a => [FlattenedInline a] -> ShowS
showList :: [FlattenedInline a] -> ShowS
Show)
data FlattenedValue a =
SingleInline (FlattenedInline a)
| NonBreaking (Seq (Seq (FlattenedValue a)))
deriving (Int -> FlattenedValue a -> ShowS
[FlattenedValue a] -> ShowS
FlattenedValue a -> String
(Int -> FlattenedValue a -> ShowS)
-> (FlattenedValue a -> String)
-> ([FlattenedValue a] -> ShowS)
-> Show (FlattenedValue a)
forall a. Show a => Int -> FlattenedValue a -> ShowS
forall a. Show a => [FlattenedValue a] -> ShowS
forall a. Show a => FlattenedValue a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FlattenedValue a -> ShowS
showsPrec :: Int -> FlattenedValue a -> ShowS
$cshow :: forall a. Show a => FlattenedValue a -> String
show :: FlattenedValue a -> String
$cshowList :: forall a. Show a => [FlattenedValue a] -> ShowS
showList :: [FlattenedValue a] -> 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
$c== :: InlineStyle -> InlineStyle -> Bool
== :: InlineStyle -> InlineStyle -> Bool
$c/= :: InlineStyle -> InlineStyle -> Bool
/= :: 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
$cshowsPrec :: Int -> InlineStyle -> ShowS
showsPrec :: Int -> InlineStyle -> ShowS
$cshow :: InlineStyle -> String
show :: InlineStyle -> String
$cshowList :: [InlineStyle] -> ShowS
showList :: [InlineStyle] -> ShowS
Show)
type FlattenM n a = ReaderT (FlattenEnv n) (State (FlattenState n)) a
data FlattenState a =
FlattenState { forall a. FlattenState a -> Seq (Seq (FlattenedValue a))
fsCompletedLines :: Seq (Seq (FlattenedValue a))
, forall a. FlattenState a -> Seq (FlattenedValue a)
fsCurLine :: Seq (FlattenedValue a)
, forall a. FlattenState a -> Int
fsNameIndex :: Int
}
data FlattenEnv a =
FlattenEnv { forall a. FlattenEnv a -> [InlineStyle]
flattenStyles :: [InlineStyle]
, forall a. FlattenEnv a -> Maybe URL
flattenURL :: Maybe URL
, forall a. FlattenEnv a -> HighlightSet
flattenHighlightSet :: HighlightSet
, forall a. FlattenEnv a -> Maybe (Int -> Inline -> Maybe a)
flattenNameGen :: Maybe (Int -> Inline -> Maybe a)
, forall a. FlattenEnv a -> Maybe (Int -> Maybe a)
flattenNameFunc :: Maybe (Int -> Maybe a)
}
flattenInlineSeq :: SemEq a
=> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Inlines
-> Seq (Seq (FlattenedValue a))
flattenInlineSeq :: forall a.
SemEq a =>
HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Inlines
-> Seq (Seq (FlattenedValue a))
flattenInlineSeq HighlightSet
hs Maybe (Int -> Inline -> Maybe a)
nameGen Inlines
is =
(Int, Seq (Seq (FlattenedValue a))) -> Seq (Seq (FlattenedValue a))
forall a b. (a, b) -> b
snd ((Int, Seq (Seq (FlattenedValue a)))
-> Seq (Seq (FlattenedValue a)))
-> (Int, Seq (Seq (FlattenedValue a)))
-> Seq (Seq (FlattenedValue a))
forall a b. (a -> b) -> a -> b
$ FlattenEnv a
-> Int -> Inlines -> (Int, Seq (Seq (FlattenedValue a)))
forall a.
SemEq a =>
FlattenEnv a
-> Int -> Inlines -> (Int, Seq (Seq (FlattenedValue a)))
flattenInlineSeq' FlattenEnv a
initialEnv Int
0 Inlines
is
where
initialEnv :: FlattenEnv a
initialEnv = FlattenEnv { flattenStyles :: [InlineStyle]
flattenStyles = []
, flattenURL :: Maybe URL
flattenURL = Maybe URL
forall a. Maybe a
Nothing
, flattenHighlightSet :: HighlightSet
flattenHighlightSet = HighlightSet
hs
, flattenNameGen :: Maybe (Int -> Inline -> Maybe a)
flattenNameGen = Maybe (Int -> Inline -> Maybe a)
nameGen
, flattenNameFunc :: Maybe (Int -> Maybe a)
flattenNameFunc = Maybe (Int -> Maybe a)
forall a. Maybe a
Nothing
}
flattenInlineSeq' :: SemEq a
=> FlattenEnv a
-> Int
-> Inlines
-> (Int, Seq (Seq (FlattenedValue a)))
flattenInlineSeq' :: forall a.
SemEq a =>
FlattenEnv a
-> Int -> Inlines -> (Int, Seq (Seq (FlattenedValue a)))
flattenInlineSeq' FlattenEnv a
env Int
c Inlines
is =
(FlattenState a -> Int
forall a. FlattenState a -> Int
fsNameIndex FlattenState a
finalState, FlattenState a -> Seq (Seq (FlattenedValue a))
forall a. FlattenState a -> Seq (Seq (FlattenedValue a))
fsCompletedLines FlattenState a
finalState)
where
finalState :: FlattenState a
finalState = State (FlattenState a) () -> FlattenState a -> FlattenState a
forall s a. State s a -> s -> s
execState State (FlattenState a) ()
stBody FlattenState a
forall {a}. FlattenState a
initialState
initialState :: FlattenState a
initialState = FlattenState { fsCompletedLines :: Seq (Seq (FlattenedValue a))
fsCompletedLines = Seq (Seq (FlattenedValue a))
forall a. Monoid a => a
mempty
, fsCurLine :: Seq (FlattenedValue a)
fsCurLine = Seq (FlattenedValue a)
forall a. Monoid a => a
mempty
, fsNameIndex :: Int
fsNameIndex = Int
c
}
stBody :: State (FlattenState a) ()
stBody = ReaderT (FlattenEnv a) (State (FlattenState a)) ()
-> FlattenEnv a -> State (FlattenState a) ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (FlattenEnv a) (State (FlattenState a)) ()
body FlattenEnv a
env
body :: ReaderT (FlattenEnv a) (State (FlattenState a)) ()
body = do
Inlines -> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines Inlines
is
ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall a. FlattenM a ()
pushFLine
flattenInlines :: SemEq a => Inlines -> FlattenM a ()
flattenInlines :: forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines Inlines
is = do
Seq (Maybe (Int -> Maybe a), Inline)
pairs <- ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Seq (Maybe (Int -> Maybe a), Inline))
forall {a}.
ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Seq (Maybe (Int -> Maybe a), Inline))
nameInlinePairs
((Maybe (Int -> Maybe a), Inline) -> FlattenM a ())
-> Seq (Maybe (Int -> Maybe a), Inline) -> FlattenM a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Maybe (Int -> Maybe a), Inline) -> FlattenM a ()
forall {a}.
SemEq a =>
(Maybe (Int -> Maybe a), Inline) -> FlattenM a ()
wrapFlatten Seq (Maybe (Int -> Maybe a), Inline)
pairs
where
wrapFlatten :: (Maybe (Int -> Maybe a), Inline) -> FlattenM a ()
wrapFlatten (Maybe (Int -> Maybe a)
nameFunc, Inline
i) = Maybe (Int -> Maybe a) -> FlattenM a () -> FlattenM a ()
forall a. Maybe (Int -> Maybe a) -> FlattenM a () -> FlattenM a ()
withNameFunc Maybe (Int -> Maybe a)
nameFunc (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inline -> FlattenM a ()
forall a. SemEq a => Inline -> FlattenM a ()
flatten Inline
i
nameInlinePairs :: ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Seq (Maybe (Int -> Maybe a), Inline))
nameInlinePairs = Seq Inline
-> (Inline
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Maybe (Int -> Maybe a), Inline))
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Seq (Maybe (Int -> Maybe a), Inline))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Inlines -> Seq Inline
unInlines Inlines
is) ((Inline
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Maybe (Int -> Maybe a), Inline))
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Seq (Maybe (Int -> Maybe a), Inline)))
-> (Inline
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Maybe (Int -> Maybe a), Inline))
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Seq (Maybe (Int -> Maybe a), Inline))
forall a b. (a -> b) -> a -> b
$ \Inline
i -> do
Maybe (Int -> Maybe a)
nameFunc <- Inline -> FlattenM a (Maybe (Int -> Maybe a))
forall a. Inline -> FlattenM a (Maybe (Int -> Maybe a))
nameGenWrapper Inline
i
(Maybe (Int -> Maybe a), Inline)
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Maybe (Int -> Maybe a), Inline)
forall a. a -> ReaderT (FlattenEnv a) (State (FlattenState a)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int -> Maybe a)
nameFunc, Inline
i)
nameGenWrapper :: Inline -> FlattenM a (Maybe (Int -> Maybe a))
nameGenWrapper :: forall a. Inline -> FlattenM a (Maybe (Int -> Maybe a))
nameGenWrapper Inline
i = do
Int
c <- (FlattenState a -> Int)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FlattenState a -> Int
forall a. FlattenState a -> Int
fsNameIndex
Maybe (Int -> Inline -> Maybe a)
nameGen <- (FlattenEnv a -> Maybe (Int -> Inline -> Maybe a))
-> ReaderT
(FlattenEnv a)
(State (FlattenState a))
(Maybe (Int -> Inline -> Maybe a))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks FlattenEnv a -> Maybe (Int -> Inline -> Maybe a)
forall a. FlattenEnv a -> Maybe (Int -> Inline -> Maybe a)
flattenNameGen
Maybe (Int -> Maybe a) -> FlattenM a (Maybe (Int -> Maybe a))
forall a. a -> ReaderT (FlattenEnv a) (State (FlattenState a)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Int -> Maybe a) -> FlattenM a (Maybe (Int -> Maybe a)))
-> Maybe (Int -> Maybe a) -> FlattenM a (Maybe (Int -> Maybe a))
forall a b. (a -> b) -> a -> b
$ case Maybe (Int -> Inline -> Maybe a)
nameGen of
Maybe (Int -> Inline -> Maybe a)
Nothing -> Maybe (Int -> Maybe a)
forall a. Maybe a
Nothing
Just Int -> Inline -> Maybe a
f -> if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Int -> Inline -> Maybe a
f Int
c Inline
i) then (Int -> Maybe a) -> Maybe (Int -> Maybe a)
forall a. a -> Maybe a
Just ((Int -> Inline -> Maybe a) -> Inline -> Int -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Inline -> Maybe a
f Inline
i) else Maybe (Int -> Maybe a)
forall a. Maybe a
Nothing
withNameFunc :: Maybe (Int -> Maybe a) -> FlattenM a () -> FlattenM a ()
withNameFunc :: forall a. Maybe (Int -> Maybe a) -> FlattenM a () -> FlattenM a ()
withNameFunc f :: Maybe (Int -> Maybe a)
f@(Just Int -> Maybe a
_) = (FlattenEnv a -> FlattenEnv a)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\FlattenEnv a
e -> FlattenEnv a
e { flattenNameFunc = f })
withNameFunc Maybe (Int -> Maybe a)
Nothing = ReaderT (FlattenEnv a) (State (FlattenState a)) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall a. a -> a
id
withInlineStyle :: InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle :: forall a. InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle InlineStyle
s =
(FlattenEnv a -> FlattenEnv a)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\FlattenEnv a
e -> FlattenEnv a
e { flattenStyles = nub (s : flattenStyles e) })
withHyperlink :: URL -> FlattenM a () -> FlattenM a ()
withHyperlink :: forall a. URL -> FlattenM a () -> FlattenM a ()
withHyperlink URL
u = (FlattenEnv a -> FlattenEnv a)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\FlattenEnv a
e -> FlattenEnv a
e { flattenURL = Just u })
pushFC :: SemEq a => FlattenedContent -> FlattenM a ()
pushFC :: forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC FlattenedContent
v = do
FlattenEnv a
env <- ReaderT (FlattenEnv a) (State (FlattenState a)) (FlattenEnv a)
forall r (m :: * -> *). MonadReader r m => m r
ask
Maybe a
name <- FlattenM a (Maybe a)
forall a. FlattenM a (Maybe a)
getNextName
let styles :: [InlineStyle]
styles = FlattenEnv a -> [InlineStyle]
forall a. FlattenEnv a -> [InlineStyle]
flattenStyles FlattenEnv a
env
mUrl :: Maybe URL
mUrl = FlattenEnv a -> Maybe URL
forall a. FlattenEnv a -> Maybe URL
flattenURL FlattenEnv a
env
fi :: FlattenedInline a
fi = FlattenedInline { fiValue :: FlattenedContent
fiValue = FlattenedContent
v
, fiStyles :: [InlineStyle]
fiStyles = [InlineStyle]
styles
, fiURL :: Maybe URL
fiURL = Maybe URL
mUrl
, fiName :: Maybe a
fiName = Maybe a
name
}
FlattenedValue a -> FlattenM a ()
forall a. SemEq a => FlattenedValue a -> FlattenM a ()
pushFV (FlattenedValue a -> FlattenM a ())
-> FlattenedValue a -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ FlattenedInline a -> FlattenedValue a
forall a. FlattenedInline a -> FlattenedValue a
SingleInline FlattenedInline a
fi
getNextName :: FlattenM a (Maybe a)
getNextName :: forall a. FlattenM a (Maybe a)
getNextName = do
Maybe (Int -> Maybe a)
nameGen <- (FlattenEnv a -> Maybe (Int -> Maybe a))
-> ReaderT
(FlattenEnv a) (State (FlattenState a)) (Maybe (Int -> Maybe a))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks FlattenEnv a -> Maybe (Int -> Maybe a)
forall a. FlattenEnv a -> Maybe (Int -> Maybe a)
flattenNameFunc
case Maybe (Int -> Maybe a)
nameGen of
Maybe (Int -> Maybe a)
Nothing -> Maybe a -> FlattenM a (Maybe a)
forall a. a -> ReaderT (FlattenEnv a) (State (FlattenState a)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Just Int -> Maybe a
f -> Int -> Maybe a
f (Int -> Maybe a)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) Int
-> FlattenM a (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (FlattenEnv a) (State (FlattenState a)) Int
forall a. FlattenM a Int
getNextNameIndex
getNextNameIndex :: FlattenM a Int
getNextNameIndex :: forall a. FlattenM a Int
getNextNameIndex = do
Int
c <- (FlattenState a -> Int) -> FlattenM a Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FlattenState a -> Int
forall a. FlattenState a -> Int
fsNameIndex
(FlattenState a -> FlattenState a)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ( \FlattenState a
s -> FlattenState a
s { fsNameIndex = c + 1} )
Int -> FlattenM a Int
forall a. a -> ReaderT (FlattenEnv a) (State (FlattenState a)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
c
setNextNameIndex :: Int -> FlattenM a ()
setNextNameIndex :: forall a. Int -> FlattenM a ()
setNextNameIndex Int
i = (FlattenState a -> FlattenState a)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ( \FlattenState a
s -> FlattenState a
s { fsNameIndex = i } )
pushFV :: SemEq a => FlattenedValue a -> FlattenM a ()
pushFV :: forall a. SemEq a => FlattenedValue a -> FlattenM a ()
pushFV FlattenedValue a
fv = State (FlattenState a) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (FlattenEnv a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (FlattenState a) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ())
-> State (FlattenState a) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall a b. (a -> b) -> a -> b
$ (FlattenState a -> FlattenState a) -> State (FlattenState a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FlattenState a -> FlattenState a) -> State (FlattenState a) ())
-> (FlattenState a -> FlattenState a) -> State (FlattenState a) ()
forall a b. (a -> b) -> a -> b
$ \FlattenState a
s -> FlattenState a
s { fsCurLine = appendFV fv (fsCurLine s) }
appendFV :: SemEq a => FlattenedValue a -> Seq (FlattenedValue a) -> Seq (FlattenedValue a)
appendFV :: forall a.
SemEq a =>
FlattenedValue a
-> Seq (FlattenedValue a) -> Seq (FlattenedValue a)
appendFV FlattenedValue a
v Seq (FlattenedValue a)
line =
case (Seq (FlattenedValue a) -> ViewR (FlattenedValue a)
forall a. Seq a -> ViewR a
Seq.viewr Seq (FlattenedValue a)
line, FlattenedValue a
v) of
(Seq (FlattenedValue a)
h :> SingleInline FlattenedInline a
a, SingleInline FlattenedInline a
b) ->
case (FlattenedInline a -> FlattenedContent
forall a. FlattenedInline a -> FlattenedContent
fiValue FlattenedInline a
a, FlattenedInline a -> FlattenedContent
forall a. FlattenedInline a -> FlattenedContent
fiValue FlattenedInline a
b) of
(FText Text
aT, FText Text
bT) ->
if FlattenedInline a -> [InlineStyle]
forall a. FlattenedInline a -> [InlineStyle]
fiStyles FlattenedInline a
a [InlineStyle] -> [InlineStyle] -> Bool
forall a. Eq a => a -> a -> Bool
== FlattenedInline a -> [InlineStyle]
forall a. FlattenedInline a -> [InlineStyle]
fiStyles FlattenedInline a
b Bool -> Bool -> Bool
&& FlattenedInline a -> Maybe URL
forall a. FlattenedInline a -> Maybe URL
fiURL FlattenedInline a
a Maybe URL -> Maybe URL -> Bool
forall a. Eq a => a -> a -> Bool
== FlattenedInline a -> Maybe URL
forall a. FlattenedInline a -> Maybe URL
fiURL FlattenedInline a
b Bool -> Bool -> Bool
&& FlattenedInline a -> Maybe a
forall a. FlattenedInline a -> Maybe a
fiName FlattenedInline a
a Maybe a -> Maybe a -> Bool
forall a. SemEq a => a -> a -> Bool
`semeq` FlattenedInline a -> Maybe a
forall a. FlattenedInline a -> Maybe a
fiName FlattenedInline a
b
then Seq (FlattenedValue a)
h Seq (FlattenedValue a)
-> FlattenedValue a -> Seq (FlattenedValue a)
forall a. Seq a -> a -> Seq a
|> FlattenedInline a -> FlattenedValue a
forall a. FlattenedInline a -> FlattenedValue a
SingleInline (FlattenedContent
-> [InlineStyle] -> Maybe URL -> Maybe a -> FlattenedInline a
forall a.
FlattenedContent
-> [InlineStyle] -> Maybe URL -> Maybe a -> FlattenedInline a
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 a -> [InlineStyle]
forall a. FlattenedInline a -> [InlineStyle]
fiStyles FlattenedInline a
a)
(FlattenedInline a -> Maybe URL
forall a. FlattenedInline a -> Maybe URL
fiURL FlattenedInline a
a)
(Maybe a -> Maybe a -> Maybe a
forall a. Ord a => a -> a -> a
max (FlattenedInline a -> Maybe a
forall a. FlattenedInline a -> Maybe a
fiName FlattenedInline a
a) (FlattenedInline a -> Maybe a
forall a. FlattenedInline a -> Maybe a
fiName FlattenedInline a
b)))
else Seq (FlattenedValue a)
line Seq (FlattenedValue a)
-> FlattenedValue a -> Seq (FlattenedValue a)
forall a. Seq a -> a -> Seq a
|> FlattenedValue a
v
(FlattenedContent, FlattenedContent)
_ -> Seq (FlattenedValue a)
line Seq (FlattenedValue a)
-> FlattenedValue a -> Seq (FlattenedValue a)
forall a. Seq a -> a -> Seq a
|> FlattenedValue a
v
(ViewR (FlattenedValue a), FlattenedValue a)
_ -> Seq (FlattenedValue a)
line Seq (FlattenedValue a)
-> FlattenedValue a -> Seq (FlattenedValue a)
forall a. Seq a -> a -> Seq a
|> FlattenedValue a
v
pushFLine :: FlattenM a ()
pushFLine :: forall a. FlattenM a ()
pushFLine =
State (FlattenState a) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (FlattenEnv a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State (FlattenState a) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ())
-> State (FlattenState a) ()
-> ReaderT (FlattenEnv a) (State (FlattenState a)) ()
forall a b. (a -> b) -> a -> b
$ (FlattenState a -> FlattenState a) -> State (FlattenState a) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((FlattenState a -> FlattenState a) -> State (FlattenState a) ())
-> (FlattenState a -> FlattenState a) -> State (FlattenState a) ()
forall a b. (a -> b) -> a -> b
$ \FlattenState a
s -> FlattenState a
s { fsCompletedLines = fsCompletedLines s |> fsCurLine s
, fsCurLine = mempty
}
isKnownUser :: T.Text -> FlattenM a Bool
isKnownUser :: forall a. Text -> FlattenM a Bool
isKnownUser Text
u = do
HighlightSet
hSet <- (FlattenEnv a -> HighlightSet)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) HighlightSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks FlattenEnv a -> HighlightSet
forall a. FlattenEnv a -> HighlightSet
flattenHighlightSet
let uSet :: Set Text
uSet = HighlightSet -> Set Text
hUserSet HighlightSet
hSet
Bool -> FlattenM a Bool
forall a. a -> ReaderT (FlattenEnv a) (State (FlattenState a)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> FlattenM a Bool) -> Bool -> FlattenM a 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 a Bool
isKnownChannel :: forall a. Text -> FlattenM a Bool
isKnownChannel Text
c = do
HighlightSet
hSet <- (FlattenEnv a -> HighlightSet)
-> ReaderT (FlattenEnv a) (State (FlattenState a)) HighlightSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks FlattenEnv a -> HighlightSet
forall a. FlattenEnv a -> HighlightSet
flattenHighlightSet
let cSet :: Set Text
cSet = HighlightSet -> Set Text
hChannelSet HighlightSet
hSet
Bool -> FlattenM a Bool
forall a. a -> ReaderT (FlattenEnv a) (State (FlattenState a)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> FlattenM a Bool) -> Bool -> FlattenM a 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 :: SemEq a => Inline -> FlattenM a ()
flatten :: forall a. SemEq a => Inline -> FlattenM a ()
flatten Inline
i =
case Inline
i of
EUser Text
u -> do
Bool
known <- Text -> FlattenM a Bool
forall a. Text -> FlattenM a Bool
isKnownUser Text
u
if Bool
known then FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (Text -> FlattenedContent
FUser Text
u)
else FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (Text -> FlattenedContent
FText (Text -> FlattenedContent) -> Text -> FlattenedContent
forall a b. (a -> b) -> a -> b
$ Text -> Text
addUserSigil Text
u)
EChannel Text
c -> do
Bool
known <- Text -> FlattenM a Bool
forall a. Text -> FlattenM a Bool
isKnownChannel Text
c
if Bool
known then FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (Text -> FlattenedContent
FChannel Text
c)
else FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
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 a
env <- ReaderT (FlattenEnv a) (State (FlattenState a)) (FlattenEnv a)
forall r (m :: * -> *). MonadReader r m => m r
ask
Int
ni <- FlattenM a Int
forall a. FlattenM a Int
getNextNameIndex
let (Int
ni', Seq (Seq (FlattenedValue a))
s) = FlattenEnv a
-> Int -> Inlines -> (Int, Seq (Seq (FlattenedValue a)))
forall a.
SemEq a =>
FlattenEnv a
-> Int -> Inlines -> (Int, Seq (Seq (FlattenedValue a)))
flattenInlineSeq' FlattenEnv a
env Int
ni Inlines
is
FlattenedValue a -> FlattenM a ()
forall a. SemEq a => FlattenedValue a -> FlattenM a ()
pushFV (FlattenedValue a -> FlattenM a ())
-> FlattenedValue a -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Seq (Seq (FlattenedValue a)) -> FlattenedValue a
forall a. Seq (Seq (FlattenedValue a)) -> FlattenedValue a
NonBreaking Seq (Seq (FlattenedValue a))
s
Int -> FlattenM a ()
forall a. Int -> FlattenM a ()
setNextNameIndex Int
ni'
Inline
ESoftBreak -> FlattenM a ()
forall a. FlattenM a ()
pushFLine
Inline
ELineBreak -> FlattenM a ()
forall a. FlattenM a ()
pushFLine
EText Text
t -> FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (FlattenedContent -> FlattenM a ())
-> FlattenedContent -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedContent
FText Text
t
Inline
ESpace -> FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC FlattenedContent
FSpace
ERawHtml Text
h -> FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (FlattenedContent -> FlattenM a ())
-> FlattenedContent -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedContent
FText Text
h
EEmoji Text
e -> FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (FlattenedContent -> FlattenM a ())
-> FlattenedContent -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Text -> FlattenedContent
FEmoji Text
e
EEditSentinel Bool
r -> FlattenedContent -> FlattenM a ()
forall a. SemEq a => FlattenedContent -> FlattenM a ()
pushFC (FlattenedContent -> FlattenM a ())
-> FlattenedContent -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Bool -> FlattenedContent
FEditSentinel Bool
r
EEmph Inlines
es -> InlineStyle -> FlattenM a () -> FlattenM a ()
forall a. InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle InlineStyle
Emph (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines Inlines
es
EStrikethrough Inlines
es -> InlineStyle -> FlattenM a () -> FlattenM a ()
forall a. InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle InlineStyle
Strikethrough (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines Inlines
es
EStrong Inlines
es -> InlineStyle -> FlattenM a () -> FlattenM a ()
forall a. InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle InlineStyle
Strong (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines Inlines
es
ECode Inlines
es -> InlineStyle -> FlattenM a () -> FlattenM a ()
forall a. InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle InlineStyle
Code (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines 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 -> FlattenM a () -> FlattenM a ()
forall a. InlineStyle -> FlattenM a () -> FlattenM a ()
withInlineStyle InlineStyle
Permalink (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines (Inlines -> FlattenM a ()) -> Inlines -> FlattenM a ()
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 -> FlattenM a () -> FlattenM a ()
forall a. URL -> FlattenM a () -> FlattenM a ()
withHyperlink URL
u (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines (Inlines -> FlattenM a ()) -> Inlines -> FlattenM a ()
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 -> FlattenM a () -> FlattenM a ()
forall a. URL -> FlattenM a () -> FlattenM a ()
withHyperlink URL
u (FlattenM a () -> FlattenM a ()) -> FlattenM a () -> FlattenM a ()
forall a b. (a -> b) -> a -> b
$ Inlines -> FlattenM a ()
forall a. SemEq a => Inlines -> FlattenM a ()
flattenInlines (Inlines -> FlattenM a ()) -> Inlines -> FlattenM a ()
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