module Yi.Misc ( getAppropriateFiles, getFolder, cd, pwd, matchingFileNames
, rot13Char, placeMark, selectAll, adjBlock, adjIndent
, promptFile , promptFileChangingHints, matchFile, completeFile
, printFileInfoE, debugBufferContent
) where
import Control.Applicative
import Control.Lens (assign)
import Control.Monad ((>=>), filterM)
import Control.Monad.Base
import Data.Char (chr, isAlpha, isLower, isUpper, ord)
import Data.List ((\\))
import Data.Maybe (isNothing)
import qualified Data.Text as T
import System.CanonicalizePath (canonicalizePath, replaceShorthands,
replaceShorthands)
import System.Directory (doesDirectoryExist, getDirectoryContents,
getCurrentDirectory, setCurrentDirectory)
import System.Environment (lookupEnv)
import System.FilePath (takeDirectory, (</>), takeFileName,
addTrailingPathSeparator,
hasTrailingPathSeparator)
import System.FriendlyPath (expandTilda, isAbsolute')
import Yi.Buffer
import Yi.Completion (completeInList')
import Yi.Editor
import Yi.Keymap
import Yi.MiniBuffer (withMinibufferGen, mkCompleteFn,
debugBufferContent)
import Yi.Monad
import qualified Yi.Rope as R
import Yi.Utils (io)
getAppropriateFiles :: Maybe T.Text -> T.Text -> YiM (T.Text, [ T.Text ])
getAppropriateFiles start s' = do
curDir <- case start of
Nothing -> do bufferPath <- withCurrentBuffer $ gets file
liftBase $ getFolder bufferPath
Just path -> return $ T.unpack path
let s = T.unpack $ replaceShorthands s'
sDir = if hasTrailingPathSeparator s then s else takeDirectory s
searchDir
| null sDir = curDir
| isAbsolute' sDir = sDir
| otherwise = curDir </> sDir
searchDir' <- liftBase $ expandTilda searchDir
let fixTrailingPathSeparator f = do
isDir <- doesDirectoryExist (searchDir' </> f)
return . T.pack $ if isDir then addTrailingPathSeparator f else f
files <- liftBase $ getDirectoryContents searchDir'
let files' = files \\ [ ".", ".." ]
fs <- liftBase $ mapM fixTrailingPathSeparator files'
let matching = filter (T.isPrefixOf . T.pack $ takeFileName s) fs
return (T.pack sDir, matching)
getFolder :: Maybe String -> IO String
getFolder Nothing = getCurrentDirectory
getFolder (Just path) = do
isDir <- doesDirectoryExist path
let dir = if isDir then path else takeDirectory path
if null dir then getCurrentDirectory else return dir
matchingFileNames :: Maybe T.Text -> T.Text -> YiM [T.Text]
matchingFileNames start s = do
(sDir, files) <- getAppropriateFiles start s
let results = if isNothing start && sDir == "." && not ("./" `T.isPrefixOf` s)
then files
else fmap (T.pack . (T.unpack sDir </>) . T.unpack) files
return results
placeMark :: BufferM ()
placeMark = do
assign highlightSelectionA True
pointB >>= setSelectionMarkPointB
selectAll :: BufferM ()
selectAll = botB >> placeMark >> topB >> setVisibleSelection True
adjBlock :: Int -> BufferM ()
adjBlock x = withSyntaxB' (\m s -> modeAdjustBlock m s x)
adjIndent :: IndentBehaviour -> BufferM ()
adjIndent ib = withSyntaxB' (\m s -> modeIndent m s ib)
promptFile :: T.Text -> (T.Text -> YiM ()) -> YiM ()
promptFile prompt act = promptFileChangingHints prompt (const return) act
promptFileChangingHints :: T.Text
-> (T.Text -> [T.Text] -> YiM [T.Text])
-> (T.Text -> YiM ())
-> YiM ()
promptFileChangingHints prompt ht act = do
maybePath <- withCurrentBuffer $ gets file
startPath <- T.pack . addTrailingPathSeparator
<$> liftBase (canonicalizePath =<< getFolder maybePath)
withMinibufferGen startPath (\x -> findFileHint startPath x >>= ht x) prompt
(completeFile startPath) showCanon (act . replaceShorthands)
where
showCanon = withCurrentBuffer . replaceBufferContent . R.fromText . replaceShorthands
matchFile :: T.Text -> T.Text -> Maybe T.Text
matchFile path proposedCompletion =
let realPath = replaceShorthands path
in T.append path <$> T.stripPrefix realPath proposedCompletion
completeFile :: T.Text -> T.Text -> YiM T.Text
completeFile startPath =
mkCompleteFn completeInList' matchFile $ matchingFileNames (Just startPath)
findFileHint :: T.Text -> T.Text -> YiM [T.Text]
findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s
onCharLetterCode :: (Int -> Int) -> Char -> Char
onCharLetterCode f c | isAlpha c = chr (f (ord c a) `mod` 26 + a)
| otherwise = c
where a | isUpper c = ord 'A'
| isLower c = ord 'a'
| otherwise = undefined
cd :: YiM ()
cd = promptFileChangingHints "switch directory to:" dirs $ \path ->
io $ getFolder (Just $ T.unpack path) >>= clean . T.pack
>>= System.Directory.setCurrentDirectory . addTrailingPathSeparator
where
replaceHome p@('~':'/':xs) = lookupEnv "HOME" >>= return . \case
Nothing -> p
Just h -> h </> xs
replaceHome p = return p
clean = replaceHome . T.unpack . replaceShorthands >=> canonicalizePath
x <//> y = T.pack $ takeDirectory (T.unpack x) </> T.unpack y
dirs :: T.Text -> [T.Text] -> YiM [T.Text]
dirs x xs = do
xsc <- io $ mapM (\y -> (,y) <$> clean (x <//> y)) xs
filterM (io . doesDirectoryExist . fst) xsc >>= return . map snd
pwd :: YiM ()
pwd = io getCurrentDirectory >>= printMsg . T.pack
rot13Char :: Char -> Char
rot13Char = onCharLetterCode (+13)
printFileInfoE :: EditorM ()
printFileInfoE = printMsg . showBufInfo =<< withCurrentBuffer bufInfoB
where showBufInfo :: BufferFileInfo -> T.Text
showBufInfo bufInfo = T.concat
[ T.pack $ bufInfoFileName bufInfo
, " Line "
, T.pack . show $ bufInfoLineNo bufInfo
, " ["
, bufInfoPercent bufInfo
, "]"
]