/
Misc.hs
115 lines (99 loc) · 4.14 KB
/
Misc.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, TypeOperators #-}
-- Copyright (c) 2008 Jean-Philippe Bernardy
-- | Various high-level functions to further classify.
module Yi.Misc
where
{- Standard Library Module Imports -}
import Data.List
( isPrefixOf
, (\\)
, filter
)
import System.FriendlyPath
( expandTilda
, isAbsolute'
)
import System.FilePath
( takeDirectory
, (</>)
, addTrailingPathSeparator
, hasTrailingPathSeparator
, takeFileName
)
import System.Directory
( doesDirectoryExist
, getDirectoryContents
, getCurrentDirectory
, canonicalizePath
)
import Control.Monad.Trans (MonadIO (..))
{- External Library Module Imports -}
{- Local (yi) module imports -}
import Prelude ()
import Yi.Core
import Yi.MiniBuffer
( withMinibuffer
, simpleComplete
, withMinibufferGen
)
-- | 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 String -> String -> YiM (String, [ String ])
getAppropriateFiles start s = do
curDir <- case start of
Nothing -> do bufferPath <- withBuffer $ gets file
liftIO $ getFolder bufferPath
(Just path) -> return path
let sDir = if hasTrailingPathSeparator s then s else takeDirectory s
searchDir = if null sDir then curDir
else if isAbsolute' sDir then sDir
else curDir </> sDir
searchDir' <- liftIO $ expandTilda searchDir
let fixTrailingPathSeparator f = do
isDir <- doesDirectoryExist (searchDir' </> f)
return $ if isDir then addTrailingPathSeparator f else f
files <- liftIO $ 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' = files \\ [ ".", ".." ]
fs <- liftIO $ mapM fixTrailingPathSeparator files'
let matching = filter (isPrefixOf $ takeFileName s) fs
return (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 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
-- | Given a possible path and a prefix, return matching file names.
matchingFileNames :: Maybe String -> String -> YiM [String]
matchingFileNames start s = do
(sDir, files) <- getAppropriateFiles start s
return $ fmap (sDir </>) files
adjBlock :: Int -> BufferM ()
adjBlock x = withSyntaxB' (\m s -> modeAdjustBlock m s x)
-- | 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 ib = withSyntaxB' (\m s -> modeIndent m s ib)
-- | Generic emacs style prompt file action. Takes a @prompt and a continuation @act
-- and prompts the user with file hints
promptFile :: String -> (String -> YiM ()) -> YiM ()
promptFile prompt act = do maybePath <- withBuffer $ gets file
startPath <- addTrailingPathSeparator <$> (liftIO $ canonicalizePath =<< getFolder maybePath)
-- TODO: Just call withMinibuffer
withMinibufferGen startPath (findFileHint startPath) prompt (simpleComplete $ matchingFileNames (Just startPath)) act
-- | 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 :: String -> String -> YiM [String]
findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s