module Language.PureScript.Interactive.Completion
( CompletionM
, liftCompletionM
, completion
, completion'
, formatCompletions
) where
import Prelude
import Protolude (ordNub)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.State.Class (MonadState(..))
import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
import Data.List (nub, isPrefixOf, isInfixOf, isSuffixOf, sortBy, stripPrefix)
import Data.Map (keys)
import Data.Maybe (mapMaybe)
import Data.Text qualified as T
import Language.PureScript qualified as P
import Language.PureScript.Interactive.Directive qualified as D
import Language.PureScript.Interactive.Types (Directive(..), PSCiState, psciExports, psciImports, psciLoadedExterns, replQueryStrings)
import System.Console.Haskeline (Completion(..), CompletionFunc, completeWordWithPrev, listFiles, simpleCompletion)
type CompletionM = ReaderT PSCiState IO
liftCompletionM
:: (MonadState PSCiState m, MonadIO m)
=> CompletionM a
-> m a
liftCompletionM :: forall (m :: * -> *) a.
(MonadState PSCiState m, MonadIO m) =>
CompletionM a -> m a
liftCompletionM CompletionM a
act = do
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CompletionM a
act PSCiState
st
completion
:: (MonadState PSCiState m, MonadIO m)
=> CompletionFunc m
completion :: forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
CompletionFunc m
completion = forall (m :: * -> *) a.
(MonadState PSCiState m, MonadIO m) =>
CompletionM a -> m a
liftCompletionM forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompletionFunc (ReaderT PSCiState IO)
completion'
completion' :: CompletionFunc CompletionM
completion' :: CompletionFunc (ReaderT PSCiState IO)
completion' = forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev forall a. Maybe a
Nothing String
" \t\n\r([" String -> String -> CompletionM [Completion]
findCompletions
findCompletions :: String -> String -> CompletionM [Completion]
findCompletions :: String -> String -> CompletionM [Completion]
findCompletions String
prev String
word = do
let ctx :: [CompletionContext]
ctx = [String] -> String -> [CompletionContext]
completionContext (String -> [String]
words (forall a. [a] -> [a]
reverse String
prev)) String
word
[Completion]
completions <- forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CompletionContext -> CompletionM [Completion]
getCompletions [CompletionContext]
ctx
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Completion -> Completion -> Ordering
directivesFirst [Completion]
completions
where
getCompletions :: CompletionContext -> CompletionM [Completion]
getCompletions :: CompletionContext -> CompletionM [Completion]
getCompletions = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> Maybe Completion
prefixedBy String
word) forall a. a -> Maybe a
Just)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompletionContext -> CompletionM [Either String Completion]
getCompletion
getCompletion :: CompletionContext -> CompletionM [Either String Completion]
getCompletion :: CompletionContext -> CompletionM [Either String Completion]
getCompletion CompletionContext
ctx =
case CompletionContext
ctx of
CtxFilePath String
f -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m [Completion]
listFiles String
f
CompletionContext
CtxModule -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompletionM [String]
getModuleNames
CompletionContext
CtxIdentifier -> forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompletionM [String]
getIdentNames forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CompletionM [String]
getDctorNames)
CtxType String
pre -> forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
pre forall a. [a] -> [a] -> [a]
++)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompletionM [String]
getTypeNames
CtxFixed String
str -> forall (m :: * -> *) a. Monad m => a -> m a
return [forall a b. a -> Either a b
Left String
str]
CtxDirective String
d -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> Either a b
Left (String -> [String]
completeDirectives String
d))
completeDirectives :: String -> [String]
completeDirectives :: String -> [String]
completeDirectives = forall a b. (a -> b) -> [a] -> [b]
map (Char
':' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
D.directiveStringsFor
prefixedBy :: String -> String -> Maybe Completion
prefixedBy :: String -> String -> Maybe Completion
prefixedBy String
w String
cand = if String
w forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
cand
then forall a. a -> Maybe a
Just (String -> Completion
simpleCompletion String
cand)
else forall a. Maybe a
Nothing
directivesFirst :: Completion -> Completion -> Ordering
directivesFirst :: Completion -> Completion -> Ordering
directivesFirst (Completion String
_ String
d1 Bool
_) (Completion String
_ String
d2 Bool
_) = String -> String -> Ordering
go String
d1 String
d2
where
go :: String -> String -> Ordering
go (Char
':' : String
xs) (Char
':' : String
ys) = forall a. Ord a => a -> a -> Ordering
compare String
xs String
ys
go (Char
':' : String
_) String
_ = Ordering
LT
go String
_ (Char
':' : String
_) = Ordering
GT
go String
xs String
ys = forall a. Ord a => a -> a -> Ordering
compare String
xs String
ys
formatCompletions :: (String, [Completion]) -> [String]
formatCompletions :: (String, [Completion]) -> [String]
formatCompletions (String
unusedR, [Completion]
completions) = [String]
actuals
where
unused :: String
unused = forall a. [a] -> [a]
reverse String
unusedR
actuals :: [String]
actuals = forall a b. (a -> b) -> [a] -> [b]
map ((String
unused forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Completion -> String
replacement) [Completion]
completions
data CompletionContext
= CtxDirective String
| CtxFilePath String
| CtxModule
| CtxIdentifier
| CtxType String
| CtxFixed String
deriving (Int -> CompletionContext -> String -> String
[CompletionContext] -> String -> String
CompletionContext -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CompletionContext] -> String -> String
$cshowList :: [CompletionContext] -> String -> String
show :: CompletionContext -> String
$cshow :: CompletionContext -> String
showsPrec :: Int -> CompletionContext -> String -> String
$cshowsPrec :: Int -> CompletionContext -> String -> String
Show)
completionContext :: [String] -> String -> [CompletionContext]
completionContext :: [String] -> String -> [CompletionContext]
completionContext [String]
_ String
w | String
"::" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
w = [String -> CompletionContext
CtxType (String
w String -> String -> String
`endingWith` String
"::")]
completionContext [String]
ws String
_ | forall a. (a -> Bool) -> [a] -> Bool
lastSatisfies (String
"::" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) [String]
ws = [String -> CompletionContext
CtxType String
""]
completionContext [] String
_ = [String -> CompletionContext
CtxDirective String
"", CompletionContext
CtxIdentifier, String -> CompletionContext
CtxFixed String
"import"]
completionContext [String]
ws String
w | forall a. (a -> Bool) -> [a] -> Bool
headSatisfies (String
":" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
ws = [String] -> String -> [CompletionContext]
completeDirective [String]
ws String
w
completionContext [String]
ws String
w | forall a. (a -> Bool) -> [a] -> Bool
headSatisfies (forall a. Eq a => a -> a -> Bool
== String
"import") [String]
ws = [String] -> String -> [CompletionContext]
completeImport [String]
ws String
w
completionContext [String]
_ String
_ = [CompletionContext
CtxIdentifier]
endingWith :: String -> String -> String
endingWith :: String -> String -> String
endingWith String
str String
stop = String -> String -> String
aux String
"" String
str
where
aux :: String -> String -> String
aux String
acc s :: String
s@(Char
x:String
xs)
| String
stop forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = forall a. [a] -> [a]
reverse (String
stop forall a. [a] -> [a] -> [a]
++ String
acc)
| Bool
otherwise = String -> String -> String
aux (Char
xforall a. a -> [a] -> [a]
:String
acc) String
xs
aux String
acc [] = forall a. [a] -> [a]
reverse (String
stop forall a. [a] -> [a] -> [a]
++ String
acc)
completeDirective :: [String] -> String -> [CompletionContext]
completeDirective :: [String] -> String -> [CompletionContext]
completeDirective [String]
ws String
w =
case [String]
ws of
[] -> [String -> CompletionContext
CtxDirective String
w]
(String
x:[String]
xs) -> case String -> [Directive]
D.directivesFor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
":" String
x of
Just [Directive
dir] -> [String] -> Directive -> [CompletionContext]
directiveArg [String]
xs Directive
dir
Maybe [Directive]
_ -> []
directiveArg :: [String] -> Directive -> [CompletionContext]
directiveArg :: [String] -> Directive -> [CompletionContext]
directiveArg [] Directive
Browse = [CompletionContext
CtxModule]
directiveArg [] Directive
Show = forall a b. (a -> b) -> [a] -> [b]
map String -> CompletionContext
CtxFixed [String]
replQueryStrings
directiveArg [String]
_ Directive
Type = [CompletionContext
CtxIdentifier]
directiveArg [String]
_ Directive
Kind = [String -> CompletionContext
CtxType String
""]
directiveArg [String]
_ Directive
_ = []
completeImport :: [String] -> String -> [CompletionContext]
completeImport :: [String] -> String -> [CompletionContext]
completeImport [String]
ws String
w' =
case ([String]
ws, String
w') of
([String
"import"], String
_) -> [CompletionContext
CtxModule]
([String], String)
_ -> []
headSatisfies :: (a -> Bool) -> [a] -> Bool
headSatisfies :: forall a. (a -> Bool) -> [a] -> Bool
headSatisfies a -> Bool
p [a]
str =
case [a]
str of
(a
c:[a]
_) -> a -> Bool
p a
c
[a]
_ -> Bool
False
lastSatisfies :: (a -> Bool) -> [a] -> Bool
lastSatisfies :: forall a. (a -> Bool) -> [a] -> Bool
lastSatisfies a -> Bool
_ [] = Bool
False
lastSatisfies a -> Bool
p [a]
xs = a -> Bool
p (forall a. [a] -> a
last [a]
xs)
getLoadedModules :: CompletionM [P.Module]
getLoadedModules :: CompletionM [Module]
getLoadedModules = forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns)
getModuleNames :: CompletionM [String]
getModuleNames :: CompletionM [String]
getModuleNames = [Module] -> [String]
moduleNames forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompletionM [Module]
getLoadedModules
getIdentNames :: CompletionM [String]
getIdentNames :: CompletionM [String]
getIdentNames = do
[Qualified Ident]
importedVals <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Imports -> Map (Qualified Ident) [ImportRecord Ident]
P.importedValues forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Imports
psciImports)
[Ident]
exportedVals <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exports -> Map Ident ExportSource
P.exportedValues forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Exports
psciExports)
[Qualified (OpName 'ValueOpName)]
importedValOps <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Imports
-> Map
(Qualified (OpName 'ValueOpName))
[ImportRecord (OpName 'ValueOpName)]
P.importedValueOps forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Imports
psciImports)
[OpName 'ValueOpName]
exportedValOps <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exports -> Map (OpName 'ValueOpName) ExportSource
P.exportedValueOps forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Exports
psciExports)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> Qualified a -> Text
P.showQualified Ident -> Text
P.showIdent) [Qualified Ident]
importedVals
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall (a :: OpNameType). OpName a -> Text
P.runOpName) [Qualified (OpName 'ValueOpName)]
importedValOps
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
P.showIdent) [Ident]
exportedVals
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: OpNameType). OpName a -> Text
P.runOpName) [OpName 'ValueOpName]
exportedValOps
getDctorNames :: CompletionM [String]
getDctorNames :: CompletionM [String]
getDctorNames = do
[Qualified (ProperName 'ConstructorName)]
imports <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Imports
-> Map
(Qualified (ProperName 'ConstructorName))
[ImportRecord (ProperName 'ConstructorName)]
P.importedDataConstructors forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Imports
psciImports)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall (a :: ProperNameType). ProperName a -> Text
P.runProperName) [Qualified (ProperName 'ConstructorName)]
imports
getTypeNames :: CompletionM [String]
getTypeNames :: CompletionM [String]
getTypeNames = do
[Qualified (ProperName 'TypeName)]
importedTypes <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Imports
-> Map
(Qualified (ProperName 'TypeName))
[ImportRecord (ProperName 'TypeName)]
P.importedTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Imports
psciImports)
[ProperName 'TypeName]
exportedTypes <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exports
-> Map
(ProperName 'TypeName)
([ProperName 'ConstructorName], ExportSource)
P.exportedTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Exports
psciExports)
[Qualified (OpName 'TypeOpName)]
importedTypeOps <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Imports
-> Map
(Qualified (OpName 'TypeOpName))
[ImportRecord (OpName 'TypeOpName)]
P.importedTypeOps forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Imports
psciImports)
[OpName 'TypeOpName]
exportedTypeOps <- forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks (forall k a. Map k a -> [k]
keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exports -> Map (OpName 'TypeOpName) ExportSource
P.exportedTypeOps forall b c a. (b -> c) -> (a -> b) -> a -> c
. PSCiState -> Exports
psciExports)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall (a :: ProperNameType). ProperName a -> Text
P.runProperName) [Qualified (ProperName 'TypeName)]
importedTypes
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Text) -> Qualified a -> Text
P.showQualified forall (a :: OpNameType). OpName a -> Text
P.runOpName) [Qualified (OpName 'TypeOpName)]
importedTypeOps
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> Text
P.runProperName) [ProperName 'TypeName]
exportedTypes
forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: OpNameType). OpName a -> Text
P.runOpName) [OpName 'TypeOpName]
exportedTypeOps
moduleNames :: [P.Module] -> [String]
moduleNames :: [Module] -> [String]
moduleNames = forall a. Ord a => [a] -> [a]
ordNub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Text
P.runModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
P.getModuleName)