{-# 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 Maybe Text
start Text
s' = do
String
curDir <- case Maybe Text
start of
Maybe Text
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 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 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]
\\ [ String
".", String
".." ]
[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 Maybe String
Nothing = IO String
getCurrentDirectory
getFolder (Just 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 Maybe Text
start Text
s = do
(Text
sDir, [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
== Text
"." Bool -> Bool -> Bool
&& Bool -> Bool
not (Text
"./" 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
Bool
True -> Bool -> BufferM ()
setVisibleSelection Bool
False
Bool
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 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)
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 (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 Text
prompt Text -> [Text] -> YiM [Text]
ht 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 (\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 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)
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
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 (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@(Char
'~':Char
'/':String
xs) = String -> IO (Maybe String)
lookupEnv String
"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
Maybe String
Nothing -> String
p
Just String
h -> String
h String -> String -> String
</> String
xs
replaceHome 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
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
[(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 (\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
+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
"]"
]
forkAction :: (YiAction a x, Show x)
=> IO Bool
-> IsRefreshNeeded
-> a
-> YiM ThreadId
forkAction :: 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 (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
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 Text
"buffer to trace:"
BufferRef -> YiM ()
debugBufferContentUsing (\[BufferRef]
_ [BufferRef]
x -> [BufferRef]
x)
debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing :: BufferRef -> YiM ()
debugBufferContentUsing 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 Int
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
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
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
>>= \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))