module Matterhorn.Draw.RichText.Wrap
( WrappedLine
, doLineWrapping
)
where
import Prelude ()
import Matterhorn.Prelude
import qualified Brick as B
import Control.Monad.State
import qualified Data.Sequence as Seq
import Data.Sequence ( ViewL(..)
, (|>)
)
import qualified Data.Text as T
import Matterhorn.Constants ( normalChannelSigil, userSigil )
import Matterhorn.Draw.RichText.Flatten
import Matterhorn.Constants ( editMarking )
type WrappedLine a = Seq (FlattenedValue a)
data WrapState a =
WrapState { WrapState a -> Seq (WrappedLine a)
wrapCompletedLines :: Seq (WrappedLine a)
, WrapState a -> WrappedLine a
wrapCurLine :: (WrappedLine a)
, WrapState a -> Int
wrapCurCol :: Int
, WrapState a -> Int
wrapWidth :: Int
}
type WrapM a b = State (WrapState b) a
pushValue :: FlattenedValue a -> WrapM () a
pushValue :: FlattenedValue a -> WrapM () a
pushValue FlattenedValue a
i = do
let iw :: Int
iw = FlattenedValue a -> Int
forall a. FlattenedValue a -> Int
fvWidth FlattenedValue a
i
pushThisInline :: WrapM () a
pushThisInline =
(WrapState a -> WrapState a) -> WrapM () a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WrapState a -> WrapState a) -> WrapM () a)
-> (WrapState a -> WrapState a) -> WrapM () a
forall a b. (a -> b) -> a -> b
$ \WrapState a
st -> WrapState a
st { wrapCurLine :: WrappedLine a
wrapCurLine = WrapState a -> WrappedLine a
forall a. WrapState a -> WrappedLine a
wrapCurLine WrapState a
st WrappedLine a -> FlattenedValue a -> WrappedLine a
forall a. Seq a -> a -> Seq a
|> FlattenedValue a
i
, wrapCurCol :: Int
wrapCurCol = WrapState a -> Int
forall a. WrapState a -> Int
wrapCurCol WrapState a
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
iw
}
Int
maxWidth <- (WrapState a -> Int) -> StateT (WrapState a) Identity Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WrapState a -> Int
forall a. WrapState a -> Int
wrapWidth
Int
curWidth <- (WrapState a -> Int) -> StateT (WrapState a) Identity Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets WrapState a -> Int
forall a. WrapState a -> Int
wrapCurCol
let remaining :: Int
remaining = Int
maxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
curWidth
Bool -> WrapM () a -> WrapM () a
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iw Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
remaining) WrapM () a
forall a. WrapM () a
pushLine
WrapM () a
pushThisInline
pushLine :: WrapM () a
pushLine :: WrapM () a
pushLine = do
let trimLeadingWhitespace :: Seq (FlattenedValue a) -> Seq (FlattenedValue a)
trimLeadingWhitespace Seq (FlattenedValue a)
s =
case Seq (FlattenedValue a) -> ViewL (FlattenedValue a)
forall a. Seq a -> ViewL a
Seq.viewl Seq (FlattenedValue a)
s of
SingleInline FlattenedInline a
i :< Seq (FlattenedValue a)
t | FlattenedInline a -> FlattenedContent
forall a. FlattenedInline a -> FlattenedContent
fiValue FlattenedInline a
i FlattenedContent -> FlattenedContent -> Bool
forall a. Eq a => a -> a -> Bool
== FlattenedContent
FSpace -> Seq (FlattenedValue a) -> Seq (FlattenedValue a)
trimLeadingWhitespace Seq (FlattenedValue a)
t
ViewL (FlattenedValue a)
_ -> Seq (FlattenedValue a)
s
(WrapState a -> WrapState a) -> WrapM () a
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((WrapState a -> WrapState a) -> WrapM () a)
-> (WrapState a -> WrapState a) -> WrapM () a
forall a b. (a -> b) -> a -> b
$ \WrapState a
st ->
WrapState a
st { wrapCurLine :: WrappedLine a
wrapCurLine = WrappedLine a
forall a. Monoid a => a
mempty
, wrapCompletedLines :: Seq (WrappedLine a)
wrapCompletedLines = WrapState a -> Seq (WrappedLine a)
forall a. WrapState a -> Seq (WrappedLine a)
wrapCompletedLines WrapState a
st Seq (WrappedLine a) -> WrappedLine a -> Seq (WrappedLine a)
forall a. Seq a -> a -> Seq a
|> WrappedLine a -> WrappedLine a
forall a. Seq (FlattenedValue a) -> Seq (FlattenedValue a)
trimLeadingWhitespace (WrapState a -> WrappedLine a
forall a. WrapState a -> WrappedLine a
wrapCurLine WrapState a
st)
, wrapCurCol :: Int
wrapCurCol = Int
0
}
doLineWrapping :: Int -> Seq (FlattenedValue a) -> Seq (WrappedLine a)
doLineWrapping :: Int -> Seq (FlattenedValue a) -> Seq (Seq (FlattenedValue a))
doLineWrapping Int
maxCols Seq (FlattenedValue a)
i =
Seq (Seq (FlattenedValue a))
result
where
result :: Seq (Seq (FlattenedValue a))
result = WrapState a -> Seq (Seq (FlattenedValue a))
forall a. WrapState a -> Seq (WrappedLine a)
wrapCompletedLines (WrapState a -> Seq (Seq (FlattenedValue a)))
-> WrapState a -> Seq (Seq (FlattenedValue a))
forall a b. (a -> b) -> a -> b
$ State (WrapState a) () -> WrapState a -> WrapState a
forall s a. State s a -> s -> s
execState ((FlattenedValue a -> State (WrapState a) ())
-> Seq (FlattenedValue a) -> State (WrapState a) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FlattenedValue a -> State (WrapState a) ()
forall a. FlattenedValue a -> WrapM () a
pushValue Seq (FlattenedValue a)
i State (WrapState a) ()
-> State (WrapState a) () -> State (WrapState a) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> State (WrapState a) ()
forall a. WrapM () a
pushLine) WrapState a
forall a. WrapState a
initialState
initialState :: WrapState a
initialState = WrapState :: forall a.
Seq (WrappedLine a) -> WrappedLine a -> Int -> Int -> WrapState a
WrapState { wrapCurLine :: WrappedLine a
wrapCurLine = WrappedLine a
forall a. Monoid a => a
mempty
, wrapCompletedLines :: Seq (WrappedLine a)
wrapCompletedLines = Seq (WrappedLine a)
forall a. Monoid a => a
mempty
, wrapCurCol :: Int
wrapCurCol = Int
0
, wrapWidth :: Int
wrapWidth = Int
maxCols
}
fvWidth :: FlattenedValue a -> Int
fvWidth :: FlattenedValue a -> Int
fvWidth (SingleInline FlattenedInline a
fi) = FlattenedInline a -> Int
forall a. FlattenedInline a -> Int
fiWidth FlattenedInline a
fi
fvWidth (NonBreaking Seq (Seq (FlattenedValue a))
rs) = Seq Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Seq Int -> Int) -> Seq Int -> Int
forall a b. (a -> b) -> a -> b
$ (Seq Int -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (Seq Int -> Int)
-> (Seq (FlattenedValue a) -> Seq Int)
-> Seq (FlattenedValue a)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FlattenedValue a -> Int) -> Seq (FlattenedValue a) -> Seq Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlattenedValue a -> Int
forall a. FlattenedValue a -> Int
fvWidth) (Seq (FlattenedValue a) -> Int)
-> Seq (Seq (FlattenedValue a)) -> Seq Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq (Seq (FlattenedValue a))
rs
fiWidth :: FlattenedInline a -> Int
fiWidth :: FlattenedInline a -> Int
fiWidth FlattenedInline a
fi =
case FlattenedInline a -> FlattenedContent
forall a. FlattenedInline a -> FlattenedContent
fiValue FlattenedInline a
fi of
FText Text
t -> Text -> Int
forall a. TextWidth a => a -> Int
B.textWidth Text
t
FlattenedContent
FSpace -> Int
1
FUser Text
t -> Text -> Int
T.length Text
userSigil Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall a. TextWidth a => a -> Int
B.textWidth Text
t
FChannel Text
t -> Text -> Int
T.length Text
normalChannelSigil Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
forall a. TextWidth a => a -> Int
B.textWidth Text
t
FEmoji Text
t -> Text -> Int
forall a. TextWidth a => a -> Int
B.textWidth Text
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
FEditSentinel Bool
_ -> Text -> Int
forall a. TextWidth a => a -> Int
B.textWidth Text
editMarking