summaryrefslogtreecommitdiff
path: root/main
diff options
context:
space:
mode:
Diffstat (limited to 'main')
-rw-r--r--main/Main.hs3
-rw-r--r--main/State.hs13
-rw-r--r--main/Terminal.hs48
3 files changed, 35 insertions, 29 deletions
diff --git a/main/Main.hs b/main/Main.hs
index 2d11dba..5fca2d9 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -54,6 +54,7 @@ import Erebos.Storable
import Erebos.Storage
import Erebos.Storage.Merge
import Erebos.Sync
+import Erebos.TextFormat
import Erebos.TextFormat.Ansi
import State
@@ -358,7 +359,7 @@ interactiveLoop st opts = withTerminal commandCompletion $ \term -> do
SelectedConversation conv -> return $ T.unpack $ conversationName conv
return $ pname ++ "> "
Right prompt -> return prompt
- lift $ setPrompt term prompt
+ lift $ setPrompt term $ plainText $ T.pack prompt
join $ lift $ getInputLine term $ \case
Just input@('/' : _) -> KeepPrompt $ return input
Just input -> ErasePrompt $ case reverse input of
diff --git a/main/State.hs b/main/State.hs
index 5d66ba9..0e20320 100644
--- a/main/State.hs
+++ b/main/State.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
module State (
loadLocalStateHead,
createLocalStateHead,
@@ -20,6 +22,7 @@ import Erebos.PubKey
import Erebos.State
import Erebos.Storable
import Erebos.Storage
+import Erebos.TextFormat
import Terminal
@@ -96,12 +99,12 @@ interactiveIdentityUpdate :: (Foldable f, MonadStorage m, MonadIO m, MonadError
interactiveIdentityUpdate term fidentity = do
identity <- mergeIdentity fidentity
name <- liftIO $ do
- setPrompt term $ T.unpack $ T.concat $ concat
- [ [ T.pack "Name" ]
+ setPrompt term $ mconcat $ concat
+ [ [ "Name" ]
, case idName identity of
- Just name -> [T.pack " [", name, T.pack "]"]
- Nothing -> []
- , [ T.pack ": " ]
+ Just name -> [ " [", plainText name, "]" ]
+ Nothing -> []
+ , [ ": " ]
]
getInputLine term $ KeepPrompt . maybe T.empty T.pack
diff --git a/main/Terminal.hs b/main/Terminal.hs
index b8b953f..97c5683 100644
--- a/main/Terminal.hs
+++ b/main/Terminal.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
module Terminal (
Terminal,
@@ -28,19 +29,24 @@ import Control.Monad
import Data.Char
import Data.List
+import Data.String
import Data.Text (Text)
import Data.Text qualified as T
+import Data.Text.IO qualified as T
import System.Console.ANSI
import System.IO
import System.IO.Error
+import Erebos.TextFormat
+import Erebos.TextFormat.Ansi
+
data Terminal = Terminal
{ termLock :: MVar ()
, termAnsi :: Bool
, termCompletionFunc :: CompletionFunc IO
- , termPrompt :: TVar String
+ , termPrompt :: TVar FormattedText
, termShowPrompt :: TVar Bool
, termInput :: TVar ( String, String )
, termBottomLines :: TVar [ String ]
@@ -114,6 +120,9 @@ termPutStr Terminal {..} str = do
putStr str
hFlush stdout
+putAnsi :: AnsiText -> IO ()
+putAnsi = T.putStr . fromAnsiText
+
getInput :: IO Input
getInput = do
@@ -154,7 +163,7 @@ getInputLine term@Terminal {..} handleResult = do
prompt <- atomically $ do
writeTVar termShowPrompt True
readTVar termPrompt
- putStr $ prompt <> "\ESC[K"
+ putAnsi $ renderAnsiText prompt <> "\ESC[K"
drawBottomLines term
hFlush stdout
@@ -195,7 +204,7 @@ getInputLine term@Terminal {..} handleResult = do
prompt <- atomically $ do
writeTVar termInput ( pre', post )
getCurrentPromptLine term
- putStr $ "\r" <> prompt
+ putAnsi $ "\r" <> prompt
hFlush stdout
termCompletionFunc ( T.pack pre, T.pack post ) >>= \case
@@ -222,7 +231,7 @@ getInputLine term@Terminal {..} handleResult = do
InputChar c | isPrint c -> withInput $ \case
( _, post ) -> do
writeTVar termInput . first (++ [ c ]) =<< readTVar termInput
- return $ c : (if null post then "" else "\ESC[s" <> post <> "\ESC[u")
+ return $ AnsiText $ T.pack $ c : (if null post then "" else "\ESC[s" <> post <> "\ESC[u")
InputChar _ -> go
@@ -272,7 +281,7 @@ getInputLine term@Terminal {..} handleResult = do
InputBackspace -> withInput $ \case
( pre@(_ : _), post ) -> do
writeTVar termInput ( init pre, post )
- return $ "\b\ESC[K" <> (if null post then "" else "\ESC[s" <> post <> "\ESC[u")
+ return $ AnsiText $ "\b\ESC[K" <> (if null post then "" else "\ESC[s" <> T.pack post <> "\ESC[u")
_ -> return ""
InputClear -> withInput $ \_ -> do
@@ -286,11 +295,11 @@ getInputLine term@Terminal {..} handleResult = do
InputMoveStart -> withInput $ \( pre, post ) -> do
writeTVar termInput ( "", pre <> post )
- return $ "\ESC[" <> show (length pre) <> "D"
+ return $ AnsiText $ T.pack $ "\ESC[" <> show (length pre) <> "D"
InputMoveEnd -> withInput $ \( pre, post ) -> do
writeTVar termInput ( pre <> post, "" )
- return $ "\ESC[" <> show (length post) <> "C"
+ return $ AnsiText $ T.pack $ "\ESC[" <> show (length post) <> "C"
InputEnd -> do
atomically (readTVar termInput) >>= \case
@@ -299,22 +308,23 @@ getInputLine term@Terminal {..} handleResult = do
InputEscape _ -> go
+ withInput :: (( String, String ) -> STM AnsiText) -> IO (Maybe String)
withInput f = do
withMVar termLock $ const $ do
str <- atomically $ f =<< readTVar termInput
- when (termAnsi && not (null str)) $ do
- putStr str
+ when (termAnsi && not (T.null $ fromAnsiText str)) $ do
+ putAnsi str
hFlush stdout
go
-getCurrentPromptLine :: Terminal -> STM String
+getCurrentPromptLine :: Terminal -> STM AnsiText
getCurrentPromptLine Terminal {..} = do
prompt <- readTVar termPrompt
( pre, post ) <- readTVar termInput
- return $ prompt <> pre <> "\ESC[s" <> post <> "\ESC[u"
+ return $ mconcat [ renderAnsiText prompt, AnsiText (T.pack pre), "\ESC[s", AnsiText (T.pack post), "\ESC[u" ]
-setPrompt :: Terminal -> String -> IO ()
+setPrompt :: Terminal -> FormattedText -> IO ()
setPrompt Terminal { termAnsi = False } _ = do
return ()
setPrompt term@Terminal {..} prompt = do
@@ -325,7 +335,7 @@ setPrompt term@Terminal {..} prompt = do
True -> do
promptLine <- getCurrentPromptLine term
return $ do
- putStr $ "\r\ESC[K" <> promptLine
+ putAnsi $ "\r\ESC[K" <> promptLine
hFlush stdout
False -> return $ return ()
@@ -340,7 +350,7 @@ printLine tlTerminal@Terminal {..} str = do
readTVar termShowPrompt >>= \case
True -> getCurrentPromptLine tlTerminal
False -> return ""
- putStr $ "\r\ESC[K" <> unlines strLines <> "\ESC[K" <> promptLine
+ putAnsi $ "\r\ESC[K" <> fromString (unlines strLines) <> "\ESC[K" <> promptLine
drawBottomLines tlTerminal
else do
putStr $ unlines strLines
@@ -382,7 +392,7 @@ drawBottomLines Terminal {..} = do
True -> do
prompt <- readTVar termPrompt
( pre, _ ) <- readTVar termInput
- return (displayWidth (prompt <> pre) + 1)
+ return (formattedTextLength prompt + length pre + 1)
False -> do
return 0
putStr $ concat
@@ -393,14 +403,6 @@ drawBottomLines Terminal {..} = do
[] -> return ()
-displayWidth :: String -> Int
-displayWidth = \case
- ('\ESC' : '[' : rest) -> displayWidth $ drop 1 $ dropWhile (not . isAlpha) rest
- ('\ESC' : _ : rest) -> displayWidth rest
- (_ : rest) -> 1 + displayWidth rest
- [] -> 0
-
-
type CompletionFunc m = ( Text, Text ) -> m ( Text, [ Completion ] )
data Completion = Completion
generated by cgit v1.2.3 (git 2.25.1) at 2026-02-04 19:41:18 +0000