0 | module Pack.CmdLn.Completion
  1 |
  2 | import Control.Monad.Trans
  3 | import Data.List
  4 | import Data.SortedMap
  5 | import Libraries.Data.List.Extra
  6 | import Pack.CmdLn
  7 | import Pack.Config
  8 | import Pack.Core
  9 | import Pack.Database
 10 | import Pack.Runner.Query
 11 | import System.Directory
 12 |
 13 | --------------------------------------------------------------------------------
 14 | --          Bash Autocompletions
 15 | --------------------------------------------------------------------------------
 16 |
 17 | -- list of `.ipkg` files in the current directory
 18 | ipkgFiles : HasIO io => io (List String)
 19 | ipkgFiles = do
 20 |   Right ss <- runEitherT currentEntries | Left _ => pure []
 21 |   pure . map interpolate $ filter isIpkgBody ss
 22 |
 23 | toDBName : Body -> Maybe String
 24 | toDBName s = case split s of
 25 |   Just (db,"toml") => Just "\{db}"
 26 |   _                => Nothing
 27 |
 28 | -- list of package collections in `$HOME/.pack/db`
 29 | collections : HasIO io => Env => io (List String)
 30 | collections = do
 31 |   Right ss <- runEitherT (entries dbDir) | Left _ => pure []
 32 |   pure $ mapMaybe toDBName ss
 33 |
 34 | -- list of packages in the currently selected data
 35 | -- collection
 36 | packages : (e : Env) => List String
 37 | packages = value <$> keys e.all
 38 |
 39 | -- list of packages in the currently selected data
 40 | -- collection
 41 | packagesOrIpkg : HasIO io => Env => io (List String)
 42 | packagesOrIpkg = do
 43 |   ps <- ipkgFiles
 44 |   pure (packages ++ ps)
 45 |
 46 | all : HasIO io => Env => io (List QPkg)
 47 | all = do
 48 |   ei <- runEitherT $ resolveAll
 49 |   pure $ either (const []) snd ei
 50 |
 51 | -- Lists only installed packages
 52 | installedLibs : HasIO io => Env => io (List String)
 53 | installedLibs = map nameStr . filter installedLib <$> all
 54 |
 55 | -- Lists only installed packages
 56 | installedApps : HasIO io => Env => io (List String)
 57 | installedApps = map nameStr . filter installedApp <$> all
 58 |
 59 | -- Lists only installed packages
 60 | apps : HasIO io => Env => io (List String)
 61 | apps = map nameStr . filter isApp <$> all
 62 |
 63 | -- keep only those Strings, of which `x` is a prefix
 64 | prefixOnly : String -> List String -> List String
 65 | prefixOnly x = sortedNub . filter (\s => x /= s && isPrefixOf x s)
 66 |
 67 | -- filter a list of Strings by the given prefix, but only if
 68 | -- the prefix is not "--", bash complete's constant for empty input.
 69 | prefixOnlyIfNonEmpty : String -> List String -> List String
 70 | prefixOnlyIfNonEmpty "--" = id
 71 | prefixOnlyIfNonEmpty s    = prefixOnly s
 72 |
 73 | -- list of package types when creating a new package
 74 | packageTypes : List String
 75 | packageTypes = map interpolate [PLib, PApp]
 76 |
 77 | packageList : String -> List String -> List String
 78 | packageList "--" xs = xs
 79 | packageList s    xs = case reverse $ split (',' ==) s of
 80 |   h ::: _ => prefixOnly h xs
 81 |
 82 | codegens : List String
 83 | codegens =
 84 |   [ "chez"
 85 |   , "chez-sep"
 86 |   , "racket"
 87 |   , "gambit"
 88 |   , "node"
 89 |   , "javascript"
 90 |   , "refc"
 91 |   , "vmcode-interp"
 92 |   ]
 93 |
 94 | commands : List String
 95 | commands = map fst Types.namesAndCommands
 96 |
 97 | optionFlags : List String
 98 | optionFlags = commands ++ optionNames
 99 |
100 | queries : Env => List String
101 | queries = ["dep", "module"] ++ packages
102 |
103 | -- Given a pair of strings, the first representing the word
104 | -- actually being edited, the second representing the word
105 | -- before the one being edited, return a list of possible
106 | -- completions. If the list of completions is empty, bash
107 | -- will perform directory completion.
108 | opts : HasIO io => Env => String -> String -> io (List String)
109 | opts "--" "pack"  = pure optionFlags
110 |
111 | -- options
112 | opts x "--package-set"    = prefixOnlyIfNonEmpty x <$> collections
113 | opts x "--with-ipkg"      = prefixOnlyIfNonEmpty x <$> ipkgFiles
114 | opts x "-p"               = prefixOnlyIfNonEmpty x <$> collections
115 | opts x "-P"               = prefixOnlyIfNonEmpty x <$> pure packages
116 | opts x "--packages"       = prefixOnlyIfNonEmpty x <$> pure packages
117 | opts x "--cg"             = prefixOnlyIfNonEmpty x <$> pure codegens
118 | opts x "--log-level"      = prefixOnlyIfNonEmpty x <$> pure (fst <$> logLevels)
119 |
120 | -- actions
121 | opts x "app-path"         = prefixOnlyIfNonEmpty x <$> installedApps
122 | opts x "build"            = prefixOnlyIfNonEmpty x <$> ipkgFiles
123 | opts x "install-deps"     = prefixOnlyIfNonEmpty x <$> ipkgFiles
124 | opts x "query"            = prefixOnlyIfNonEmpty x <$> pure queries
125 | opts x "fuzzy"            = packageList          x <$> installedLibs
126 | opts x "dep"              = prefixOnlyIfNonEmpty x <$> pure packages
127 | opts x "modules"          = prefixOnlyIfNonEmpty x <$> pure packages
128 | opts x "check-db"         = prefixOnlyIfNonEmpty x <$> collections
129 | opts x "run"              = prefixOnlyIfNonEmpty x <$> packagesOrIpkg
130 | opts x "install"          = prefixOnlyIfNonEmpty x <$> pure packages
131 | opts x "test"             = prefixOnlyIfNonEmpty x <$> pure packages
132 | opts x "install-app"      = prefixOnlyIfNonEmpty x <$> apps
133 | opts x "remove"           = prefixOnlyIfNonEmpty x <$> installedLibs
134 | opts x "remove-app"       = prefixOnlyIfNonEmpty x <$> installedApps
135 | opts x "switch"           = prefixOnlyIfNonEmpty x . ("latest" ::)
136 |                             <$> collections
137 | opts x "clean"            = prefixOnlyIfNonEmpty x <$> ipkgFiles
138 | opts x "typecheck"        = prefixOnlyIfNonEmpty x <$> ipkgFiles
139 | opts x "new"              = prefixOnlyIfNonEmpty x <$> pure packageTypes
140 | opts x "uninstall"        = pure Nil
141 | opts x "help"             = prefixOnlyIfNonEmpty x <$> pure commands
142 |
143 | -- options
144 | opts x _ = pure $
145 |   if (x `elem` optionFlags)
146 |     -- `x` is already a known option => perform
147 |     -- directory completion
148 |     then Nil
149 |     else prefixOnly x optionFlags
150 |
151 | ||| Prints tab-completion options based on the last and second-to-last
152 | ||| command line argument.
153 | export
154 | complete : HasIO io => String -> String -> Env -> EitherT PackErr io ()
155 | complete a b e = do
156 |   os <- lift $ opts a b
157 |   putStr $ unlines os
158 |
159 | ||| Bash autocompletion script using the given function name
160 | export
161 | completionScript : (fun : String) -> String
162 | completionScript fun = let fun' = "_" ++ fun in """
163 |   \{ fun' }()
164 |   {
165 |     ED=$([ -z $2 ] && echo "--" || echo $2)
166 |     COMPREPLY=($(pack completion $ED $3))
167 |   }
168 |
169 |   complete -F \{ fun' } -o default pack
170 |   """
171 |