{-# 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
  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'

  -- 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]
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)

-- | 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
  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


-- | 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
  (Text
sDir, [Text]
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 :: [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

-- | 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 (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

-- | Select the contents of the whole buffer
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

-- | 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 (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
  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)
  -- TODO: Just call withMinibuffer
  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)

-- | 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 (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

-- | 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 (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 :: 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)

-- | 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
  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))