module System.Console.Haskeline.Backend.DumbTerm where

import System.Console.Haskeline.Backend.Posix
import System.Console.Haskeline.Backend.WCWidth
import System.Console.Haskeline.Term
import System.Console.Haskeline.LineState
import System.Console.Haskeline.Monads as Monads

import System.IO
import Control.Applicative(Applicative)
import Control.Monad(liftM)
import Control.Monad.Catch

-- TODO: 
---- Put "<" and ">" at end of term if scrolls off.
---- Have a margin at the ends

data Window = Window {Window -> Int
pos :: Int -- ^ # of visible chars to left of cursor
                }

initWindow :: Window
initWindow :: Window
initWindow = Window {pos :: Int
pos=Int
0}

newtype DumbTerm m a = DumbTerm {forall (m :: * -> *) a. DumbTerm m a -> StateT Window (PosixT m) a
unDumbTerm :: StateT Window (PosixT m) a}
                deriving ((forall a b. (a -> b) -> DumbTerm m a -> DumbTerm m b)
-> (forall a b. a -> DumbTerm m b -> DumbTerm m a)
-> Functor (DumbTerm m)
forall a b. a -> DumbTerm m b -> DumbTerm m a
forall a b. (a -> b) -> DumbTerm m a -> DumbTerm m b
forall (m :: * -> *) a b.
Functor m =>
a -> DumbTerm m b -> DumbTerm m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DumbTerm m a -> DumbTerm m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> DumbTerm m a -> DumbTerm m b
fmap :: forall a b. (a -> b) -> DumbTerm m a -> DumbTerm m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> DumbTerm m b -> DumbTerm m a
<$ :: forall a b. a -> DumbTerm m b -> DumbTerm m a
Functor, Functor (DumbTerm m)
Functor (DumbTerm m) =>
(forall a. a -> DumbTerm m a)
-> (forall a b.
    DumbTerm m (a -> b) -> DumbTerm m a -> DumbTerm m b)
-> (forall a b c.
    (a -> b -> c) -> DumbTerm m a -> DumbTerm m b -> DumbTerm m c)
-> (forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m b)
-> (forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m a)
-> Applicative (DumbTerm m)
forall a. a -> DumbTerm m a
forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m a
forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m b
forall a b. DumbTerm m (a -> b) -> DumbTerm m a -> DumbTerm m b
forall a b c.
(a -> b -> c) -> DumbTerm m a -> DumbTerm m b -> DumbTerm m c
forall (m :: * -> *). Monad m => Functor (DumbTerm m)
forall (m :: * -> *) a. Monad m => a -> DumbTerm m a
forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> DumbTerm m b -> DumbTerm m a
forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> DumbTerm m b -> DumbTerm m b
forall (m :: * -> *) a b.
Monad m =>
DumbTerm m (a -> b) -> DumbTerm m a -> DumbTerm m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DumbTerm m a -> DumbTerm m b -> DumbTerm m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> DumbTerm m a
pure :: forall a. a -> DumbTerm m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
DumbTerm m (a -> b) -> DumbTerm m a -> DumbTerm m b
<*> :: forall a b. DumbTerm m (a -> b) -> DumbTerm m a -> DumbTerm m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> DumbTerm m a -> DumbTerm m b -> DumbTerm m c
liftA2 :: forall a b c.
(a -> b -> c) -> DumbTerm m a -> DumbTerm m b -> DumbTerm m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> DumbTerm m b -> DumbTerm m b
*> :: forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> DumbTerm m b -> DumbTerm m a
<* :: forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m a
Applicative, Applicative (DumbTerm m)
Applicative (DumbTerm m) =>
(forall a b. DumbTerm m a -> (a -> DumbTerm m b) -> DumbTerm m b)
-> (forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m b)
-> (forall a. a -> DumbTerm m a)
-> Monad (DumbTerm m)
forall a. a -> DumbTerm m a
forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m b
forall a b. DumbTerm m a -> (a -> DumbTerm m b) -> DumbTerm m b
forall (m :: * -> *). Monad m => Applicative (DumbTerm m)
forall (m :: * -> *) a. Monad m => a -> DumbTerm m a
forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> DumbTerm m b -> DumbTerm m b
forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> (a -> DumbTerm m b) -> DumbTerm m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> (a -> DumbTerm m b) -> DumbTerm m b
>>= :: forall a b. DumbTerm m a -> (a -> DumbTerm m b) -> DumbTerm m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
DumbTerm m a -> DumbTerm m b -> DumbTerm m b
>> :: forall a b. DumbTerm m a -> DumbTerm m b -> DumbTerm m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> DumbTerm m a
return :: forall a. a -> DumbTerm m a
Monad, Monad (DumbTerm m)
Monad (DumbTerm m) =>
(forall a. IO a -> DumbTerm m a) -> MonadIO (DumbTerm m)
forall a. IO a -> DumbTerm m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (DumbTerm m)
forall (m :: * -> *) a. MonadIO m => IO a -> DumbTerm m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> DumbTerm m a
liftIO :: forall a. IO a -> DumbTerm m a
MonadIO,
                          Monad (DumbTerm m)
Monad (DumbTerm m) =>
(forall e a. (HasCallStack, Exception e) => e -> DumbTerm m a)
-> MonadThrow (DumbTerm m)
forall e a. (HasCallStack, Exception e) => e -> DumbTerm m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (DumbTerm m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> DumbTerm m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> DumbTerm m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> DumbTerm m a
MonadThrow, MonadThrow (DumbTerm m)
MonadThrow (DumbTerm m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 DumbTerm m a -> (e -> DumbTerm m a) -> DumbTerm m a)
-> MonadCatch (DumbTerm m)
forall e a.
(HasCallStack, Exception e) =>
DumbTerm m a -> (e -> DumbTerm m a) -> DumbTerm m a
forall (m :: * -> *). MonadCatch m => MonadThrow (DumbTerm m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
DumbTerm m a -> (e -> DumbTerm m a) -> DumbTerm m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
DumbTerm m a -> (e -> DumbTerm m a) -> DumbTerm m a
catch :: forall e a.
(HasCallStack, Exception e) =>
DumbTerm m a -> (e -> DumbTerm m a) -> DumbTerm m a
MonadCatch, MonadCatch (DumbTerm m)
MonadCatch (DumbTerm m) =>
(forall b.
 HasCallStack =>
 ((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
 -> DumbTerm m b)
-> (forall b.
    HasCallStack =>
    ((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
    -> DumbTerm m b)
-> (forall a b c.
    HasCallStack =>
    DumbTerm m a
    -> (a -> ExitCase b -> DumbTerm m c)
    -> (a -> DumbTerm m b)
    -> DumbTerm m (b, c))
-> MonadMask (DumbTerm m)
forall b.
HasCallStack =>
((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
-> DumbTerm m b
forall a b c.
HasCallStack =>
DumbTerm m a
-> (a -> ExitCase b -> DumbTerm m c)
-> (a -> DumbTerm m b)
-> DumbTerm m (b, c)
forall (m :: * -> *). MonadMask m => MonadCatch (DumbTerm m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
-> DumbTerm m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
DumbTerm m a
-> (a -> ExitCase b -> DumbTerm m c)
-> (a -> DumbTerm m b)
-> DumbTerm m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
-> DumbTerm m b
mask :: forall b.
HasCallStack =>
((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
-> DumbTerm m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
-> DumbTerm m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. DumbTerm m a -> DumbTerm m a) -> DumbTerm m b)
-> DumbTerm m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
DumbTerm m a
-> (a -> ExitCase b -> DumbTerm m c)
-> (a -> DumbTerm m b)
-> DumbTerm m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
DumbTerm m a
-> (a -> ExitCase b -> DumbTerm m c)
-> (a -> DumbTerm m b)
-> DumbTerm m (b, c)
MonadMask,
                          MonadState Window, MonadReader Handles)

type DumbTermM a = forall m . (MonadIO m, MonadReader Layout m) => DumbTerm m a

instance MonadTrans DumbTerm where
    lift :: forall (m :: * -> *) a. Monad m => m a -> DumbTerm m a
lift = StateT Window (PosixT m) a -> DumbTerm m a
forall (m :: * -> *) a. StateT Window (PosixT m) a -> DumbTerm m a
DumbTerm (StateT Window (PosixT m) a -> DumbTerm m a)
-> (m a -> StateT Window (PosixT m) a) -> m a -> DumbTerm m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixT m a -> StateT Window (PosixT m) a
forall (m :: * -> *) a. Monad m => m a -> StateT Window m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (PosixT m a -> StateT Window (PosixT m) a)
-> (m a -> PosixT m a) -> m a -> StateT Window (PosixT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> PosixT m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Handles m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

evalDumb :: (MonadReader Layout m, CommandMonad m) => EvalTerm (PosixT m)
evalDumb :: forall (m :: * -> *).
(MonadReader Layout m, CommandMonad m) =>
EvalTerm (PosixT m)
evalDumb = (forall a. DumbTerm m a -> PosixT m a)
-> (forall a. PosixT m a -> DumbTerm m a) -> EvalTerm (PosixT m)
forall (m :: * -> *) (n :: * -> *).
(Term n, CommandMonad n) =>
(forall a. n a -> m a) -> (forall a. m a -> n a) -> EvalTerm m
EvalTerm (Window -> StateT Window (PosixT m) a -> ReaderT Handles m a
forall (m :: * -> *) s a. Monad m => s -> StateT s m a -> m a
evalStateT' Window
initWindow (StateT Window (PosixT m) a -> ReaderT Handles m a)
-> (DumbTerm m a -> StateT Window (PosixT m) a)
-> DumbTerm m a
-> ReaderT Handles m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DumbTerm m a -> StateT Window (PosixT m) a
forall (m :: * -> *) a. DumbTerm m a -> StateT Window (PosixT m) a
unDumbTerm) (StateT Window (PosixT m) a -> DumbTerm m a
forall (m :: * -> *) a. StateT Window (PosixT m) a -> DumbTerm m a
DumbTerm (StateT Window (PosixT m) a -> DumbTerm m a)
-> (PosixT m a -> StateT Window (PosixT m) a)
-> PosixT m a
-> DumbTerm m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PosixT m a -> StateT Window (PosixT m) a
forall (m :: * -> *) a. Monad m => m a -> StateT Window m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift)

runDumbTerm :: Handles -> MaybeT IO RunTerm
runDumbTerm :: Handles -> MaybeT IO RunTerm
runDumbTerm Handles
h = IO RunTerm -> MaybeT IO RunTerm
forall a. IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RunTerm -> MaybeT IO RunTerm)
-> IO RunTerm -> MaybeT IO RunTerm
forall a b. (a -> b) -> a -> b
$ Handles
-> [IO (Maybe Layout)]
-> [(String, Key)]
-> (forall (m :: * -> *) b. (MonadIO m, MonadMask m) => m b -> m b)
-> (forall (m :: * -> *).
    (MonadMask m, CommandMonad m) =>
    EvalTerm (PosixT m))
-> IO RunTerm
posixRunTerm Handles
h (Handles -> [IO (Maybe Layout)]
posixLayouts Handles
h) [] m b -> m b
forall a. a -> a
forall (m :: * -> *) b. (MonadIO m, MonadMask m) => m b -> m b
id EvalTerm (PosixT m)
forall (m :: * -> *).
(MonadMask m, CommandMonad m) =>
EvalTerm (PosixT m)
forall (m :: * -> *).
(MonadReader Layout m, CommandMonad m) =>
EvalTerm (PosixT m)
evalDumb
                                
instance (MonadIO m, MonadMask m, MonadReader Layout m) => Term (DumbTerm m) where
    reposition :: Layout -> LineChars -> DumbTerm m ()
reposition Layout
_ LineChars
s = LineChars -> DumbTermM ()
refitLine LineChars
s
    drawLineDiff :: LineChars -> LineChars -> DumbTerm m ()
drawLineDiff LineChars
x LineChars
y = LineChars -> LineChars -> DumbTermM ()
drawLineDiff' LineChars
x LineChars
y
    
    printLines :: [String] -> DumbTerm m ()
printLines = (String -> DumbTerm m ()) -> [String] -> DumbTerm m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText (String -> DumbTerm m ())
-> (String -> String) -> String -> DumbTerm m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
crlf))
    moveToNextLine :: LineChars -> DumbTerm m ()
moveToNextLine LineChars
_ = String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText String
crlf
    clearLayout :: DumbTerm m ()
clearLayout = DumbTerm m ()
DumbTermM ()
clearLayoutD
    ringBell :: Bool -> DumbTerm m ()
ringBell Bool
True = String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText String
"\a"
    ringBell Bool
False = () -> DumbTerm m ()
forall a. a -> DumbTerm m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      
printText :: MonadIO m => String -> DumbTerm m ()
printText :: forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText String
str = do
    Handle
h <- (Handles -> Handle) -> DumbTerm m Handles -> DumbTerm m Handle
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Handles -> Handle
ehOut DumbTerm m Handles
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO () -> DumbTerm m ()
forall a. IO a -> DumbTerm m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DumbTerm m ()) -> IO () -> DumbTerm m ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStr Handle
h String
str
    IO () -> DumbTerm m ()
forall a. IO a -> DumbTerm m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DumbTerm m ()) -> IO () -> DumbTerm m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
h

-- Things we can assume a dumb terminal knows how to do
cr,crlf :: String
crlf :: String
crlf = String
"\r\n"
cr :: String
cr = String
"\r"

backs,spaces :: Int -> String
backs :: Int -> String
backs Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'\b'
spaces :: Int -> String
spaces Int
n = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
' '


clearLayoutD :: DumbTermM ()
clearLayoutD :: DumbTermM ()
clearLayoutD = do
    Int
w <- DumbTerm m Int
DumbTermM Int
maxWidth
    String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText (String
cr String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
spaces Int
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cr)

-- Don't want to print in the last column, as that may wrap to the next line.
maxWidth :: DumbTermM Int
maxWidth :: DumbTermM Int
maxWidth = (Layout -> Int) -> DumbTerm m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (\Layout
lay -> Layout -> Int
width Layout
lay Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

drawLineDiff' :: LineChars -> LineChars -> DumbTermM ()
drawLineDiff' :: LineChars -> LineChars -> DumbTermM ()
drawLineDiff' ([Grapheme]
xs1,[Grapheme]
ys1) ([Grapheme]
xs2,[Grapheme]
ys2) = do
    Window {pos :: Window -> Int
pos=Int
p} <- DumbTerm m Window
forall s (m :: * -> *). MonadState s m => m s
get
    Int
w <- DumbTerm m Int
DumbTermM Int
maxWidth
    let ([Grapheme]
xs1',[Grapheme]
xs2') = [Grapheme] -> [Grapheme] -> LineChars
forall a. Eq a => [a] -> [a] -> ([a], [a])
matchInit [Grapheme]
xs1 [Grapheme]
xs2
    let (Int
xw1, Int
xw2) = ([Grapheme] -> Int
gsWidth [Grapheme]
xs1', [Grapheme] -> Int
gsWidth [Grapheme]
xs2')
    let newP :: Int
newP = Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
xw2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw1
    let ([Grapheme]
ys2', Int
yw2) = Int -> [Grapheme] -> ([Grapheme], Int)
takeWidth (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
newP) [Grapheme]
ys2
    if Int
xw1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
p  Bool -> Bool -> Bool
|| Int
newP Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
w
        then LineChars -> DumbTermM ()
refitLine ([Grapheme]
xs2,[Grapheme]
ys2)
        else do -- we haven't moved outside the margins
            Window -> DumbTerm m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Window {pos :: Int
pos=Int
newP}
            case ([Grapheme]
xs1',[Grapheme]
xs2') of
                ([],[]) | [Grapheme]
ys1 [Grapheme] -> [Grapheme] -> Bool
forall a. Eq a => a -> a -> Bool
== [Grapheme]
ys2    -> () -> DumbTerm m ()
forall a. a -> DumbTerm m a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- no change
                ([Grapheme]
_,[]) | [Grapheme]
xs1' [Grapheme] -> [Grapheme] -> [Grapheme]
forall a. [a] -> [a] -> [a]
++ [Grapheme]
ys1 [Grapheme] -> [Grapheme] -> Bool
forall a. Eq a => a -> a -> Bool
== [Grapheme]
ys2 -> -- moved left
                    String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText (String -> DumbTerm m ()) -> String -> DumbTerm m ()
forall a b. (a -> b) -> a -> b
$ Int -> String
backs Int
xw1
                ([],[Grapheme]
_) | [Grapheme]
ys1 [Grapheme] -> [Grapheme] -> Bool
forall a. Eq a => a -> a -> Bool
== [Grapheme]
xs2' [Grapheme] -> [Grapheme] -> [Grapheme]
forall a. [a] -> [a] -> [a]
++ [Grapheme]
ys2 -> -- moved right
                    String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText ([Grapheme] -> String
graphemesToString [Grapheme]
xs2')
                LineChars
_ -> let extraLength :: Int
extraLength = Int
xw1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Grapheme], Int) -> Int
forall a b. (a, b) -> b
snd (Int -> [Grapheme] -> ([Grapheme], Int)
takeWidth (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
p) [Grapheme]
ys1)
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
xw2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
yw2
                     in String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText (String -> DumbTerm m ()) -> String -> DumbTerm m ()
forall a b. (a -> b) -> a -> b
$ Int -> String
backs Int
xw1
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Grapheme] -> String
graphemesToString ([Grapheme]
xs2' [Grapheme] -> [Grapheme] -> [Grapheme]
forall a. [a] -> [a] -> [a]
++ [Grapheme]
ys2') String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
clearDeadText Int
extraLength
                        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
backs Int
yw2

refitLine :: ([Grapheme],[Grapheme]) -> DumbTermM ()
refitLine :: LineChars -> DumbTermM ()
refitLine ([Grapheme]
xs,[Grapheme]
ys) = do
    Int
w <- DumbTerm m Int
DumbTermM Int
maxWidth
    let ([Grapheme]
xs',Int
p) = Int -> [Grapheme] -> ([Grapheme], Int)
dropFrames Int
w [Grapheme]
xs
    Window -> DumbTerm m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Window {pos :: Int
pos=Int
p}
    let ([Grapheme]
ys',Int
k) = Int -> [Grapheme] -> ([Grapheme], Int)
takeWidth (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p) [Grapheme]
ys
    String -> DumbTerm m ()
forall (m :: * -> *). MonadIO m => String -> DumbTerm m ()
printText (String -> DumbTerm m ()) -> String -> DumbTerm m ()
forall a b. (a -> b) -> a -> b
$ String
cr String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Grapheme] -> String
graphemesToString ([Grapheme]
xs' [Grapheme] -> [Grapheme] -> [Grapheme]
forall a. [a] -> [a] -> [a]
++ [Grapheme]
ys')
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
spaces (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
p)
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
backs (Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
p)
  where
    -- returns the width of the returned characters.
    dropFrames :: Int -> [Grapheme] -> ([Grapheme], Int)
dropFrames Int
w [Grapheme]
zs = case Int -> [Grapheme] -> ([Grapheme], [Grapheme], Int)
splitAtWidth Int
w [Grapheme]
zs of
                        ([Grapheme]
_,[],Int
l) -> ([Grapheme]
zs,Int
l)
                        ([Grapheme]
_,[Grapheme]
zs',Int
_) -> Int -> [Grapheme] -> ([Grapheme], Int)
dropFrames Int
w [Grapheme]
zs'

    
clearDeadText :: Int -> String
clearDeadText :: Int -> String
clearDeadText Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> String
spaces Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
backs Int
n
                | Bool
otherwise = String
""