{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeOperators     #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Misc
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Various high-level functions to further classify.

module Yi.Misc ( getAppropriateFiles, getFolder, cd, pwd, matchingFileNames
               , rot13Char, placeMark, selectAll, adjIndent
               , promptFile , promptFileChangingHints, matchFile, completeFile
               , printFileInfoE, debugBufferContent
               ) where

import           Control.Concurrent
import           Control.Monad           (filterM, (>=>), when, void)
import           Control.Monad.Base      (liftBase)
import           Data.Char               (chr, isAlpha, isLower, isUpper, ord)
import           Data.IORef
import           Data.List               ((\\))
import           Data.Maybe              (isNothing)
import qualified Data.Text               as T (Text, append, concat, isPrefixOf,
                                               pack, stripPrefix, unpack)
import           System.CanonicalizePath (canonicalizePath, replaceShorthands, replaceShorthands)
import           System.Directory        (doesDirectoryExist,
                                          getCurrentDirectory,
                                          getDirectoryContents,
                                          setCurrentDirectory)
import           System.Environment      (lookupEnv)
import           System.FilePath         (addTrailingPathSeparator,
                                          hasTrailingPathSeparator,
                                          takeDirectory, takeFileName, (</>))
import           System.FriendlyPath     (expandTilda, isAbsolute')
import           Yi.Buffer
import           Yi.Completion           (completeInList')
import           Yi.Core                 (onYiVar)
import           Yi.Editor               (EditorM, printMsg, withCurrentBuffer, withGivenBuffer, findBuffer)
import           Yi.Keymap               (YiM, makeAction, YiAction)
import           Yi.MiniBuffer           (mkCompleteFn, withMinibufferGen, promptingForBuffer)
import           Yi.Monad                (gets)
import qualified Yi.Rope                 as R (fromText, YiString)
import           Yi.Types                (IsRefreshNeeded(..), Yi(..))
import           Yi.Utils                (io)

-- | Given a possible starting path (which if not given defaults to
-- the current directory) and a fragment of a path we find all files
-- within the given (or current) directory which can complete the
-- given path fragment. We return a pair of both directory plus the
-- filenames on their own that is without their directories. The
-- reason for this is that if we return all of the filenames then we
-- get a 'hint' which is way too long to be particularly useful.
getAppropriateFiles :: Maybe T.Text -> T.Text -> YiM (T.Text, [ T.Text ])
getAppropriateFiles :: Maybe Text -> Text -> YiM (Text, [Text])
getAppropriateFiles Maybe Text
start Text
s' = do
  curDir <- case Maybe Text
start of
    Maybe Text
Nothing -> do bufferPath <- BufferM (Maybe String) -> YiM (Maybe String)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe String) -> YiM (Maybe String))
-> BufferM (Maybe String) -> YiM (Maybe String)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe String) -> BufferM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe String
file
                  liftBase $ getFolder bufferPath
    Just Text
path -> String -> YiM String
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> YiM String) -> String -> YiM String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
path
  let s = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
replaceShorthands Text
s'
      sDir = if String -> Bool
hasTrailingPathSeparator String
s then String
s else String -> String
takeDirectory String
s
      searchDir
        | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sDir = String
curDir
        | String -> Bool
isAbsolute' String
sDir = String
sDir
        | Bool
otherwise = String
curDir String -> String -> String
</> String
sDir
  searchDir' <- liftBase $ expandTilda searchDir
  let fixTrailingPathSeparator String
f = do
        isDir <- String -> IO Bool
doesDirectoryExist (String
searchDir' String -> String -> String
</> String
f)
        return . T.pack $ if isDir then addTrailingPathSeparator f else f

  files <- liftBase $ getDirectoryContents searchDir'

  -- Remove the two standard current-dir and parent-dir as we do not
  -- need to complete or hint about these as they are known by users.
  let files' = [String]
files [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ String
".", String
".." ]
  fs <- liftBase $ mapM fixTrailingPathSeparator files'
  let matching = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isPrefixOf (Text -> Text -> Bool)
-> (String -> Text) -> String -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text -> Bool) -> String -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String
takeFileName String
s) [Text]
fs
  return (T.pack sDir, matching)

-- | Given a path, trim the file name bit if it exists.  If no path
--   given, return current directory.
getFolder :: Maybe String -> IO String
getFolder :: Maybe String -> IO String
getFolder Maybe String
Nothing     = IO String
getCurrentDirectory
getFolder (Just String
path) = do
  isDir <- String -> IO Bool
doesDirectoryExist String
path
  let dir = if Bool
isDir then String
path else String -> String
takeDirectory String
path
  if null dir then getCurrentDirectory else return dir


-- | Given a possible path and a prefix, return matching file names.
matchingFileNames :: Maybe T.Text -> T.Text -> YiM [T.Text]
matchingFileNames :: Maybe Text -> Text -> YiM [Text]
matchingFileNames Maybe Text
start Text
s = do
  (sDir, files) <- Maybe Text -> Text -> YiM (Text, [Text])
getAppropriateFiles Maybe Text
start Text
s

  -- There is one common case when we don't need to prepend @sDir@ to @files@:
  --
  -- Suppose user just wants to edit a file "foobar" in current directory
  -- and inputs ":e foo<Tab>"
  --
  -- @sDir@ in this case equals to "." and "foo" would not be
  -- a prefix of ("." </> "foobar"), resulting in a failed completion
  --
  -- However, if user inputs ":e ./foo<Tab>", we need to prepend @sDir@ to @files@
  let results = if Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Text
start Bool -> Bool -> Bool
&& Text
sDir Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"." Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"./" Text -> Text -> Bool
`T.isPrefixOf` Text
s)
                   then [Text]
files
                   else (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String
T.unpack Text
sDir String -> String -> String
</>) (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
files

  return results

-- | Place mark at current point. If there's an existing mark at point
-- already, deactivate mark.
placeMark :: BufferM ()
placeMark :: BufferM ()
placeMark = Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Point -> Point -> Bool)
-> BufferM Point -> BufferM (Point -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufferM Point
pointB BufferM (Point -> Bool) -> BufferM Point -> BufferM Bool
forall a b. BufferM (a -> b) -> BufferM a -> BufferM b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Point
getSelectionMarkPointB BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True -> Bool -> BufferM ()
setVisibleSelection Bool
False
  Bool
False -> Bool -> BufferM ()
setVisibleSelection Bool
True BufferM () -> BufferM Point -> BufferM Point
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall a b. BufferM a -> (a -> BufferM b) -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB

-- | Select the contents of the whole buffer
selectAll :: BufferM ()
selectAll :: BufferM ()
selectAll = BufferM ()
botB BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
placeMark BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
topB BufferM () -> BufferM () -> BufferM ()
forall a b. BufferM a -> BufferM b -> BufferM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> BufferM ()
setVisibleSelection Bool
True

-- | A simple wrapper to adjust the current indentation using
-- the mode specific indentation function but according to the
-- given indent behaviour.
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent IndentBehaviour
ib = (forall syntax. Mode syntax -> syntax -> BufferM ()) -> BufferM ()
forall a.
(forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a
withSyntaxB' (\Mode syntax
m syntax
s -> Mode syntax -> syntax -> IndentBehaviour -> BufferM ()
forall syntax.
Mode syntax -> syntax -> IndentBehaviour -> BufferM ()
modeIndent Mode syntax
m syntax
s IndentBehaviour
ib)

-- | Generic emacs style prompt file action. Takes a @prompt@ and a continuation
-- @act@ and prompts the user with file hints.
promptFile :: T.Text -> (T.Text -> YiM ()) -> YiM ()
promptFile :: Text -> (Text -> YiM ()) -> YiM ()
promptFile Text
prompt Text -> YiM ()
act = Text
-> (Text -> [Text] -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
promptFileChangingHints Text
prompt (([Text] -> YiM [Text]) -> Text -> [Text] -> YiM [Text]
forall a b. a -> b -> a
const [Text] -> YiM [Text]
forall a. a -> YiM a
forall (m :: * -> *) a. Monad m => a -> m a
return) Text -> YiM ()
act

-- | As 'promptFile' but additionally allows the caller to transform
-- the list of hints arbitrarily, such as only showing directories.
promptFileChangingHints :: T.Text -- ^ Prompt
                        -> (T.Text -> [T.Text] -> YiM [T.Text])
                        -- ^ Hint transformer: current path, generated hints
                        -> (T.Text -> YiM ()) -- ^ Action over choice
                        -> YiM ()
promptFileChangingHints :: Text
-> (Text -> [Text] -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
promptFileChangingHints Text
prompt Text -> [Text] -> YiM [Text]
ht Text -> YiM ()
act = do
  maybePath <- BufferM (Maybe String) -> YiM (Maybe String)
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM (Maybe String) -> YiM (Maybe String))
-> BufferM (Maybe String) -> YiM (Maybe String)
forall a b. (a -> b) -> a -> b
$ (FBuffer -> Maybe String) -> BufferM (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBuffer -> Maybe String
file
  startPath <- T.pack . addTrailingPathSeparator
               <$> liftBase (canonicalizePath =<< getFolder maybePath)
  -- TODO: Just call withMinibuffer
  withMinibufferGen startPath (\Text
x -> Text -> Text -> YiM [Text]
findFileHint Text
startPath Text
x YiM [Text] -> ([Text] -> YiM [Text]) -> YiM [Text]
forall a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Text] -> YiM [Text]
ht Text
x) prompt
    (completeFile startPath) showCanon (act . replaceShorthands)
  where
    showCanon :: Text -> YiM ()
showCanon = BufferM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM () -> YiM ()) -> (Text -> BufferM ()) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YiString -> BufferM ()
replaceBufferContent (YiString -> BufferM ())
-> (Text -> YiString) -> Text -> BufferM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> YiString
R.fromText (Text -> YiString) -> (Text -> Text) -> Text -> YiString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
replaceShorthands

matchFile :: T.Text -> T.Text -> Maybe T.Text
matchFile :: Text -> Text -> Maybe Text
matchFile Text
path Text
proposedCompletion =
  let realPath :: Text
realPath = Text -> Text
replaceShorthands Text
path
  in Text -> Text -> Text
T.append Text
path (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Maybe Text
T.stripPrefix Text
realPath Text
proposedCompletion

completeFile :: T.Text -> T.Text -> YiM T.Text
completeFile :: Text -> Text -> YiM Text
completeFile Text
startPath =
  (Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text)
-> (Text -> Text -> Maybe Text)
-> (Text -> YiM [Text])
-> Text
-> YiM Text
mkCompleteFn Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
completeInList' Text -> Text -> Maybe Text
matchFile ((Text -> YiM [Text]) -> Text -> YiM Text)
-> (Text -> YiM [Text]) -> Text -> YiM Text
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> YiM [Text]
matchingFileNames (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
startPath)

-- | For use as the hint when opening a file using the minibuffer. We
-- essentially return all the files in the given directory which have
-- the given prefix.
findFileHint :: T.Text -> T.Text -> YiM [T.Text]
findFileHint :: Text -> Text -> YiM [Text]
findFileHint Text
startPath Text
s = (Text, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ((Text, [Text]) -> [Text]) -> YiM (Text, [Text]) -> YiM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Text -> YiM (Text, [Text])
getAppropriateFiles (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
startPath) Text
s

onCharLetterCode :: (Int -> Int) -> Char -> Char
onCharLetterCode :: (Int -> Int) -> Char -> Char
onCharLetterCode Int -> Int
f Char
c | Char -> Bool
isAlpha Char
c = Int -> Char
chr (Int -> Int
f (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
a)
                     | Bool
otherwise = Char
c
                     where a :: Int
a | Char -> Bool
isUpper Char
c = Char -> Int
ord Char
'A'
                             | Char -> Bool
isLower Char
c = Char -> Int
ord Char
'a'
                             | Bool
otherwise = Int
forall a. HasCallStack => a
undefined

-- | Like @M-x cd@, it changes the current working directory. Mighty
-- useful when we don't start Yi from the project directory or want to
-- switch projects, as many tools only use the current working
-- directory.
cd :: YiM ()
cd :: YiM ()
cd = Text
-> (Text -> [Text] -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
promptFileChangingHints Text
"switch directory to:" Text -> [Text] -> YiM [Text]
dirs ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \Text
path ->
  IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> IO String
getFolder (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
path) IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO String
clean (Text -> IO String) -> (String -> Text) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
       IO String -> (String -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ()
System.Directory.setCurrentDirectory (String -> IO ()) -> (String -> String) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addTrailingPathSeparator
  where
     replaceHome :: String -> IO String
replaceHome p :: String
p@(Char
'~':Char
'/':String
xs) = String -> IO (Maybe String)
lookupEnv String
"HOME" IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String)
-> (Maybe String -> String) -> Maybe String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
       Maybe String
Nothing -> String
p
       Just String
h -> String
h String -> String -> String
</> String
xs
     replaceHome String
p = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
p
     clean :: Text -> IO String
clean = String -> IO String
replaceHome (String -> IO String) -> (Text -> String) -> Text -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
replaceShorthands (Text -> IO String) -> (String -> IO String) -> Text -> IO String
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> IO String
canonicalizePath

     Text
x <//> :: Text -> Text -> Text
<//> Text
y = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory (Text -> String
T.unpack Text
x) String -> String -> String
</> Text -> String
T.unpack Text
y

     dirs :: T.Text -> [T.Text] -> YiM [T.Text]
     dirs :: Text -> [Text] -> YiM [Text]
dirs Text
x [Text]
xs = do
       xsc <- IO [(String, Text)] -> YiM [(String, Text)]
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO [(String, Text)] -> YiM [(String, Text)])
-> IO [(String, Text)] -> YiM [(String, Text)]
forall a b. (a -> b) -> a -> b
$ (Text -> IO (String, Text)) -> [Text] -> IO [(String, Text)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Text
y -> (,Text
y) (String -> (String, Text)) -> IO String -> IO (String, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO String
clean (Text
x Text -> Text -> Text
<//> Text
y)) [Text]
xs
       filterM (io . doesDirectoryExist . fst) xsc >>= return . map snd

-- | Shows current working directory. Also see 'cd'.
pwd :: YiM ()
pwd :: YiM ()
pwd = IO String -> YiM String
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io IO String
getCurrentDirectory YiM String -> (String -> YiM ()) -> YiM ()
forall a b. YiM a -> (a -> YiM b) -> YiM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> YiM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> YiM ()) -> (String -> Text) -> String -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

rot13Char :: Char -> Char
rot13Char :: Char -> Char
rot13Char = (Int -> Int) -> Char -> Char
onCharLetterCode (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
13)

printFileInfoE :: EditorM ()
printFileInfoE :: EditorM ()
printFileInfoE = Text -> EditorM ()
forall (m :: * -> *). MonadEditor m => Text -> m ()
printMsg (Text -> EditorM ())
-> (BufferFileInfo -> Text) -> BufferFileInfo -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferFileInfo -> Text
showBufInfo (BufferFileInfo -> EditorM ())
-> EditorM BufferFileInfo -> EditorM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BufferM BufferFileInfo -> EditorM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB
    where showBufInfo :: BufferFileInfo -> T.Text
          showBufInfo :: BufferFileInfo -> Text
showBufInfo BufferFileInfo
bufInfo = [Text] -> Text
T.concat
            [ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ BufferFileInfo -> String
bufInfoFileName BufferFileInfo
bufInfo
            , Text
" Line "
            , String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ BufferFileInfo -> Int
bufInfoLineNo BufferFileInfo
bufInfo
            , Text
" ["
            , BufferFileInfo -> Text
bufInfoPercent BufferFileInfo
bufInfo
            , Text
"]"
            ]

-- | Runs a 'YiM' action in a separate thread.
--
-- Notes:
--
-- * It seems to work but I don't know why
--
-- * Maybe deadlocks?
--
-- * If you're outputting into the Yi window, you should really limit
-- the rate at which you do so: for example, the Pango front-end will
-- quite happily segfault/double-free if you output too fast.
--
-- I am exporting this for those adventurous to play with but I have
-- only discovered how to do this a night before the release so it's
-- rather experimental. A simple function that prints a message once a
-- second, 5 times, could be written like this:
--
-- @
-- printer :: YiM ThreadId
-- printer = do
--   mv <- io $ newMVar (0 :: Int)
--   forkAction (suicide mv) MustRefresh $ do
--     c <- io $ do
--       modifyMVar_ mv (return . succ)
--       tryReadMVar mv
--     case c of
--       Nothing -> printMsg "messaging unknown time"
--       Just x -> printMsg $ "message #" <> showT x
--   where
--     suicide mv = tryReadMVar mv >>= \case
--       Just i | i >= 5 -> return True
--       _ -> threadDelay 1000000 >> return False
-- @
forkAction :: (YiAction a x, Show x)
           => IO Bool
              -- ^ runs after we insert the action: this may be a
              -- thread delay or a thread suicide or whatever else;
              -- when delay returns False, that's our signal to
              -- terminate the thread.
           -> IsRefreshNeeded
              -- ^ should we refresh after each action
           -> a
              -- ^ The action to actually run
           -> YiM ThreadId
forkAction :: forall a x.
(YiAction a x, Show x) =>
IO Bool -> IsRefreshNeeded -> a -> YiM ThreadId
forkAction IO Bool
delay IsRefreshNeeded
ref a
ym = (Yi -> YiVar -> IO (YiVar, ThreadId)) -> YiM ThreadId
forall a. (Yi -> YiVar -> IO (YiVar, a)) -> YiM a
onYiVar ((Yi -> YiVar -> IO (YiVar, ThreadId)) -> YiM ThreadId)
-> (Yi -> YiVar -> IO (YiVar, ThreadId)) -> YiM ThreadId
forall a b. (a -> b) -> a -> b
$ \Yi
yi YiVar
yv -> do
  let loop :: IO ()
loop = do
        Yi -> IsRefreshNeeded -> [Action] -> IO ()
yiOutput Yi
yi IsRefreshNeeded
ref [a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction a
ym]
        IO Bool
delay IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
loop
  t <- IO () -> IO ThreadId
forkIO IO ()
loop
  return (yv, t)

-- | Prints out the rope of the current buffer as-is to stdout.
--
-- The only way to stop it is to close the buffer in question which
-- should free up the 'BufferRef'.
debugBufferContent :: YiM ()
debugBufferContent :: YiM ()
debugBufferContent = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer Text
"buffer to trace:"
                     BufferRef -> YiM ()
debugBufferContentUsing (\[BufferRef]
_ [BufferRef]
x -> [BufferRef]
x)

debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing BufferRef
b = do
  mv <- IO (IORef YiString) -> YiM (IORef YiString)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO (IORef YiString) -> YiM (IORef YiString))
-> IO (IORef YiString) -> YiM (IORef YiString)
forall a b. (a -> b) -> a -> b
$ YiString -> IO (IORef YiString)
forall a. a -> IO (IORef a)
newIORef YiString
forall a. Monoid a => a
mempty
  keepGoing <- io $ newIORef True
  let delay = Int -> IO ()
threadDelay Int
100000 IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
keepGoing
  void . forkAction delay NoNeedToRefresh $
    findBuffer b >>= \case
      Maybe FBuffer
Nothing -> IO () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
keepGoing Bool
True
      Just FBuffer
_ -> do
        ns <- BufferRef -> BufferM YiString -> YiM YiString
forall (m :: * -> *) a.
MonadEditor m =>
BufferRef -> BufferM a -> m a
withGivenBuffer BufferRef
b BufferM YiString
elemsB :: YiM R.YiString
        io $ readIORef mv >>= \YiString
c ->
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (YiString
c YiString -> YiString -> Bool
forall a. Eq a => a -> a -> Bool
/= YiString
ns) (YiString -> IO ()
forall a. Show a => a -> IO ()
print YiString
ns IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IORef YiString -> YiString -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef YiString
mv YiString
ns))