1 files changed, 32 insertions, 20 deletions

diff --git a/main/Main.hs b/main/Main.hs
index 8a4729f..d91330c 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -31,7 +31,7 @@ import Data.Typeable
 import Network.Socket
 
 import System.Console.GetOpt
-import System.Console.Haskeline
+import System.Directory
 import System.Environment
 import System.Exit
 import System.IO
@@ -40,21 +40,24 @@ import Erebos.Attach
 import Erebos.Contact
 import Erebos.Chatroom
 import Erebos.Conversation
+import Erebos.DirectMessage
 import Erebos.Discovery
 #ifdef ENABLE_ICE_SUPPORT
 import Erebos.ICE
 #endif
 import Erebos.Identity
-import Erebos.Message hiding (formatMessage)
 import Erebos.Network
+import Erebos.Object
 import Erebos.PubKey
 import Erebos.Service
 import Erebos.Set
 import Erebos.State
+import Erebos.Storable
 import Erebos.Storage
 import Erebos.Storage.Merge
 import Erebos.Sync
 
+import Terminal
 import Test
 import Version
 
@@ -173,6 +176,14 @@ servicesOptions = concatMap helper $ "all" : map soptName availableServices
         | otherwise =   s : change name f ss
     change _ _ []   = []
 
+getDefaultStorageDir :: IO FilePath
+getDefaultStorageDir = do
+    lookupEnv "EREBOS_DIR" >>= \case
+        Just dir -> return dir
+        Nothing -> doesFileExist "./.erebos/erebos-storage" >>= \case
+            True -> return "./.erebos"
+            False -> getXdgDirectory XdgData "erebos"
+
 main :: IO ()
 main = do
     (opts, args) <- (getOpt RequireOrder (options ++ servicesOptions) <$> getArgs) >>= \case
@@ -184,7 +195,7 @@ main = do
             exitFailure
 
     st <- liftIO $ case optStorage opts of
-        DefaultStorage         -> openStorage . fromMaybe "./.erebos" =<< lookupEnv "EREBOS_DIR"
+        DefaultStorage         -> openStorage =<< getDefaultStorageDir
         FilesystemStorage path -> openStorage path
         MemoryStorage          -> memoryStorage
 
@@ -264,22 +275,20 @@ main = do
             exitFailure
 
 
-inputSettings :: Settings IO
-inputSettings = setComplete commandCompletion $ defaultSettings
-
 interactiveLoop :: Storage -> Options -> IO ()
-interactiveLoop st opts = runInputT inputSettings $ do
+interactiveLoop st opts = withTerminal commandCompletion $ \term -> do
     erebosHead <- liftIO $ loadLocalStateHead st
-    outputStrLn $ T.unpack $ displayIdentity $ headLocalIdentity erebosHead
+    void $ printLine term $ T.unpack $ displayIdentity $ headLocalIdentity erebosHead
 
-    tui <- haveTerminalUI
-    extPrint <- getExternalPrint
+    let tui = hasTerminalUI term
+    let extPrint = void . printLine term
     let extPrintLn str = do
             let str' = case reverse str of ('\n':_) -> str
                                            _ -> str ++ "\n";
             extPrint $! str' -- evaluate str before calling extPrint to avoid blinking
 
-    let getInputLinesTui eprompt = do
+    let getInputLinesTui :: Either CommandState String -> MaybeT IO String
+        getInputLinesTui eprompt = do
             prompt <- case eprompt of
                 Left cstate -> do
                     pname <- case csContext cstate of
@@ -293,11 +302,14 @@ interactiveLoop st opts = runInputT inputSettings $ do
                         SelectedConversation conv -> return $ T.unpack $ conversationName conv
                     return $ pname ++ "> "
                 Right prompt -> return prompt
-            Just input <- lift $ getInputLine prompt
-            case reverse input of
-                 _ | all isSpace input -> getInputLinesTui eprompt
-                 '\\':rest -> (reverse ('\n':rest) ++) <$> getInputLinesTui (Right ">> ")
-                 _         -> return input
+            lift $ setPrompt term prompt
+            join $ lift $ getInputLine term $ \case
+                Just input@('/' : _) -> KeepPrompt $ return input
+                Just input -> ErasePrompt $ case reverse input of
+                    _ | all isSpace input -> getInputLinesTui eprompt
+                    '\\':rest -> (reverse ('\n':rest) ++) <$> getInputLinesTui (Right ">> ")
+                    _         -> return input
+                Nothing -> KeepPrompt mzero
 
         getInputCommandTui cstate = do
             input <- getInputLinesTui cstate
@@ -310,7 +322,7 @@ interactiveLoop st opts = runInputT inputSettings $ do
             return (cmd, line)
 
         getInputLinesPipe = do
-            lift (getInputLine "") >>= \case
+            join $ lift $ getInputLine term $ KeepPrompt . \case
                 Just input -> return input
                 Nothing -> liftIO $ forever $ threadDelay 100000000
 
@@ -371,12 +383,12 @@ interactiveLoop st opts = runInputT inputSettings $ do
                 when (Just shown /= op) $ extPrintLn $ "[" <> show idx <> "] PEER " <> updateType' <> " " <> shown
             _ -> return ()
 
-    let process :: CommandState -> MaybeT (InputT IO) CommandState
+    let process :: CommandState -> MaybeT IO CommandState
         process cstate = do
             (cmd, line) <- getInputCommand cstate
             h <- liftIO (reloadHead $ csHead cstate) >>= \case
                 Just h  -> return h
-                Nothing -> do lift $ lift $ extPrintLn "current head deleted"
+                Nothing -> do lift $ extPrintLn "current head deleted"
                               mzero
             res <- liftIO $ runExceptT $ flip execStateT cstate { csHead = h } $ runReaderT cmd CommandInput
                 { ciServer = server
@@ -396,7 +408,7 @@ interactiveLoop st opts = runInputT inputSettings $ do
                     | csQuit cstate' -> mzero
                     | otherwise      -> return cstate'
                 Left err -> do
-                    lift $ lift $ extPrintLn $ "Error: " ++ err
+                    lift $ extPrintLn $ "Error: " ++ err
                     return cstate
 
     let loop (Just cstate) = runMaybeT (process cstate) >>= loop