{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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)
getAppropriateFiles :: Maybe T.Text -> T.Text -> YiM (T.Text, [ T.Text ])
getAppropriateFiles :: Maybe Text -> Text -> YiM (Text, [Text])
getAppropriateFiles start :: Maybe Text
start s' :: Text
s' = do
String
curDir <- case Maybe Text
start of
Nothing -> do Maybe String
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
IO String -> YiM String
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ Maybe String -> IO String
getFolder Maybe String
bufferPath
Just path :: Text
path -> String -> YiM String
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 :: String
s = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
replaceShorthands Text
s'
sDir :: String
sDir = if String -> Bool
hasTrailingPathSeparator String
s then String
s else String -> String
takeDirectory String
s
searchDir :: String
searchDir
| String -> 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
String
searchDir' <- IO String -> YiM String
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO String -> YiM String) -> IO String -> YiM String
forall a b. (a -> b) -> a -> b
$ String -> IO String
expandTilda String
searchDir
let fixTrailingPathSeparator :: String -> IO Text
fixTrailingPathSeparator f :: String
f = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist (String
searchDir' String -> String -> String
</> String
f)
Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> (String -> Text) -> String -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> IO Text) -> String -> IO Text
forall a b. (a -> b) -> a -> b
$ if Bool
isDir then String -> String
addTrailingPathSeparator String
f else String
f
[String]
files <- IO [String] -> YiM [String]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [String] -> YiM [String]) -> IO [String] -> YiM [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
searchDir'
let files' :: [String]
files' = [String]
files [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ ".", ".." ]
[Text]
fs <- IO [Text] -> YiM [Text]
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO [Text] -> YiM [Text]) -> IO [Text] -> YiM [Text]
forall a b. (a -> b) -> a -> b
$ (String -> IO Text) -> [String] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO Text
fixTrailingPathSeparator [String]
files'
let matching :: [Text]
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
(Text, [Text]) -> YiM (Text, [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
sDir, [Text]
matching)
getFolder :: Maybe String -> IO String
getFolder :: Maybe String -> IO String
getFolder Nothing = IO String
getCurrentDirectory
getFolder (Just path :: String
path) = do
Bool
isDir <- String -> IO Bool
doesDirectoryExist String
path
let dir :: String
dir = if Bool
isDir then String
path else String -> String
takeDirectory String
path
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then IO String
getCurrentDirectory else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
matchingFileNames :: Maybe T.Text -> T.Text -> YiM [T.Text]
matchingFileNames :: Maybe Text -> Text -> YiM [Text]
matchingFileNames start :: Maybe Text
start s :: Text
s = do
(sDir :: Text
sDir, files :: [Text]
files) <- Maybe Text -> Text -> YiM (Text, [Text])
getAppropriateFiles Maybe Text
start Text
s
let results :: [Text]
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
== "." Bool -> Bool -> Bool
&& Bool -> Bool
not ("./" Text -> Text -> Bool
`T.isPrefixOf` Text
s)
then [Text]
files
else (Text -> Text) -> [Text] -> [Text]
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
[Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
results
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BufferM Point
getSelectionMarkPointB BufferM Bool -> (Bool -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
True -> Bool -> BufferM ()
setVisibleSelection Bool
False
False -> Bool -> BufferM ()
setVisibleSelection Bool
True BufferM () -> BufferM Point -> BufferM Point
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM Point
pointB BufferM Point -> (Point -> BufferM ()) -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Point -> BufferM ()
setSelectionMarkPointB
selectAll :: BufferM ()
selectAll :: BufferM ()
selectAll = BufferM ()
botB BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
placeMark BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferM ()
topB BufferM () -> BufferM () -> BufferM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> BufferM ()
setVisibleSelection Bool
True
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent ib :: IndentBehaviour
ib = (forall syntax. Mode syntax -> syntax -> BufferM ()) -> BufferM ()
forall a.
(forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a
withSyntaxB' (\m :: Mode syntax
m s :: syntax
s -> Mode syntax -> syntax -> IndentBehaviour -> BufferM ()
forall syntax.
Mode syntax -> syntax -> IndentBehaviour -> BufferM ()
modeIndent Mode syntax
m syntax
s IndentBehaviour
ib)
promptFile :: T.Text -> (T.Text -> YiM ()) -> YiM ()
promptFile :: Text -> (Text -> YiM ()) -> YiM ()
promptFile prompt :: Text
prompt act :: 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 (m :: * -> *) a. Monad m => a -> m a
return) Text -> YiM ()
act
promptFileChangingHints :: T.Text
-> (T.Text -> [T.Text] -> YiM [T.Text])
-> (T.Text -> YiM ())
-> YiM ()
promptFileChangingHints :: Text
-> (Text -> [Text] -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
promptFileChangingHints prompt :: Text
prompt ht :: Text -> [Text] -> YiM [Text]
ht act :: Text -> YiM ()
act = do
Maybe String
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
Text
startPath <- String -> Text
T.pack (String -> Text) -> (String -> String) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
addTrailingPathSeparator
(String -> Text) -> YiM String -> YiM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> YiM String
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (String -> IO String
canonicalizePath (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String -> IO String
getFolder Maybe String
maybePath)
Text
-> (Text -> YiM [Text])
-> Text
-> (Text -> YiM Text)
-> (Text -> YiM ())
-> (Text -> YiM ())
-> YiM ()
withMinibufferGen Text
startPath (\x :: Text
x -> Text -> Text -> YiM [Text]
findFileHint Text
startPath Text
x YiM [Text] -> ([Text] -> YiM [Text]) -> YiM [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> [Text] -> YiM [Text]
ht Text
x) Text
prompt
(Text -> Text -> YiM Text
completeFile Text
startPath) Text -> YiM ()
showCanon (Text -> YiM ()
act (Text -> YiM ()) -> (Text -> Text) -> Text -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
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 path :: Text
path proposedCompletion :: 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 startPath :: 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)
findFileHint :: T.Text -> T.Text -> YiM [T.Text]
findFileHint :: Text -> Text -> YiM [Text]
findFileHint startPath :: Text
startPath s :: 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 f :: Int -> Int
f c :: 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` 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 'A'
| Char -> Bool
isLower Char
c = Char -> Int
ord 'a'
| Bool
otherwise = Int
forall a. HasCallStack => a
undefined
cd :: YiM ()
cd :: YiM ()
cd = Text
-> (Text -> [Text] -> YiM [Text]) -> (Text -> YiM ()) -> YiM ()
promptFileChangingHints "switch directory to:" Text -> [Text] -> YiM [Text]
dirs ((Text -> YiM ()) -> YiM ()) -> (Text -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \path :: 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 (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 (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@('~':'/':xs :: String
xs) = String -> IO (Maybe String)
lookupEnv "HOME" IO (Maybe String) -> (Maybe String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
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
Nothing -> String
p
Just h :: String
h -> String
h String -> String -> String
</> String
xs
replaceHome p :: String
p = String -> IO String
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
x :: Text
x <//> :: Text -> Text -> Text
<//> y :: 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 x :: Text
x xs :: [Text]
xs = do
[(String, Text)]
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)
mapM (\y :: 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
((String, Text) -> YiM Bool)
-> [(String, Text)] -> YiM [(String, Text)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> YiM Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> YiM Bool)
-> ((String, Text) -> IO Bool) -> (String, Text) -> YiM Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesDirectoryExist (String -> IO Bool)
-> ((String, Text) -> String) -> (String, Text) -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Text) -> String
forall a b. (a, b) -> a
fst) [(String, Text)]
xsc YiM [(String, Text)]
-> ([(String, Text)] -> YiM [Text]) -> YiM [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Text] -> YiM [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> YiM [Text])
-> ([(String, Text)] -> [Text]) -> [(String, Text)] -> YiM [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Text) -> Text) -> [(String, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String, Text) -> Text
forall a b. (a, b) -> b
snd
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 (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
+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 bufInfo :: 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
, " 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
, " ["
, BufferFileInfo -> Text
bufInfoPercent BufferFileInfo
bufInfo
, "]"
]
forkAction :: (YiAction a x, Show x)
=> IO Bool
-> IsRefreshNeeded
-> a
-> YiM ThreadId
forkAction :: IO Bool -> IsRefreshNeeded -> a -> YiM ThreadId
forkAction delay :: IO Bool
delay ref :: IsRefreshNeeded
ref ym :: 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
yi yv :: 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: Bool
b -> Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b IO ()
loop
ThreadId
t <- IO () -> IO ThreadId
forkIO IO ()
loop
(YiVar, ThreadId) -> IO (YiVar, ThreadId)
forall (m :: * -> *) a. Monad m => a -> m a
return (YiVar
yv, ThreadId
t)
debugBufferContent :: YiM ()
debugBufferContent :: YiM ()
debugBufferContent = Text
-> (BufferRef -> YiM ())
-> ([BufferRef] -> [BufferRef] -> [BufferRef])
-> YiM ()
promptingForBuffer "buffer to trace:"
BufferRef -> YiM ()
debugBufferContentUsing (\_ x :: [BufferRef]
x -> [BufferRef]
x)
debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing b :: BufferRef
b = do
IORef YiString
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
IORef Bool
keepGoing <- IO (IORef Bool) -> YiM (IORef Bool)
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO (IORef Bool) -> YiM (IORef Bool))
-> IO (IORef Bool) -> YiM (IORef Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
True
let delay :: IO Bool
delay = Int -> IO ()
threadDelay 100000 IO () -> IO Bool -> IO Bool
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
YiM ThreadId -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM ThreadId -> YiM ())
-> (YiM () -> YiM ThreadId) -> YiM () -> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> IsRefreshNeeded -> YiM () -> YiM ThreadId
forall a x.
(YiAction a x, Show x) =>
IO Bool -> IsRefreshNeeded -> a -> YiM ThreadId
forkAction IO Bool
delay IsRefreshNeeded
NoNeedToRefresh (YiM () -> YiM ()) -> YiM () -> YiM ()
forall a b. (a -> b) -> a -> b
$
BufferRef -> YiM (Maybe FBuffer)
forall (m :: * -> *).
MonadEditor m =>
BufferRef -> m (Maybe FBuffer)
findBuffer BufferRef
b YiM (Maybe FBuffer) -> (Maybe FBuffer -> YiM ()) -> YiM ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
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 _ -> do
YiString
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 () -> YiM ()
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO () -> YiM ()) -> IO () -> YiM ()
forall a b. (a -> b) -> a -> b
$ IORef YiString -> IO YiString
forall a. IORef a -> IO a
readIORef IORef YiString
mv IO YiString -> (YiString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c :: 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 (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))