{-# LANGUAGE DoAndIfThenElse #-}
module Language.PureScript.Interactive
( handleCommand
, module Interactive
, make
, runMake
) where
import Prelude
import Protolude (ordNub)
import Data.List (sort, find, foldl')
import Data.Maybe (fromMaybe, mapMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.State.Class
import Control.Monad.Reader.Class
import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.State.Strict (StateT, runStateT, evalStateT)
import Control.Monad.Writer.Strict (Writer(), runWriter)
import qualified Language.PureScript as P
import qualified Language.PureScript.CST as CST
import qualified Language.PureScript.Names as N
import qualified Language.PureScript.Constants.Prim as C
import Language.PureScript.Interactive.Completion as Interactive
import Language.PureScript.Interactive.IO as Interactive
import Language.PureScript.Interactive.Message as Interactive
import Language.PureScript.Interactive.Module as Interactive
import Language.PureScript.Interactive.Parser as Interactive
import Language.PureScript.Interactive.Printer as Interactive
import Language.PureScript.Interactive.Types as Interactive
import System.Directory (getCurrentDirectory)
import System.FilePath ((</>))
import System.FilePath.Glob (glob)
printErrors :: MonadIO m => P.MultipleErrors -> m ()
printErrors :: forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
FilePath
pwd <- IO FilePath
getCurrentDirectory
FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ PPEOptions -> MultipleErrors -> FilePath
P.prettyPrintMultipleErrors PPEOptions
P.defaultPPEOptions {ppeRelativeDirectory :: FilePath
P.ppeRelativeDirectory = FilePath
pwd} MultipleErrors
errs
runMake :: P.Make a -> IO (Either P.MultipleErrors a)
runMake :: forall a. Make a -> IO (Either MultipleErrors a)
runMake Make a
mk = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Options -> Make a -> IO (Either MultipleErrors a, MultipleErrors)
P.runMake Options
P.defaultOptions Make a
mk
rebuild
:: [P.ExternsFile]
-> P.Module
-> P.Make (P.ExternsFile, P.Environment)
rebuild :: [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild [ExternsFile]
loadedExterns Module
m = do
ExternsFile
externs <- forall (m :: * -> *).
(Monad m, MonadBaseControl IO m, MonadError MultipleErrors m,
MonadWriter MultipleErrors m) =>
MakeActions m -> [ExternsFile] -> Module -> m ExternsFile
P.rebuildModule MakeActions Make
buildActions [ExternsFile]
loadedExterns Module
m
forall (m :: * -> *) a. Monad m => a -> m a
return (ExternsFile
externs, forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip ExternsFile -> Environment -> Environment
P.applyExternsFileToEnvironment) Environment
P.initEnvironment ([ExternsFile]
loadedExterns forall a. [a] -> [a] -> [a]
++ [ExternsFile
externs]))
where
buildActions :: P.MakeActions P.Make
buildActions :: MakeActions Make
buildActions =
(FilePath
-> Map ModuleName (Either RebuildPolicy FilePath)
-> Map ModuleName FilePath
-> Bool
-> MakeActions Make
P.buildMakeActions FilePath
modulesDir
Map ModuleName (Either RebuildPolicy FilePath)
filePathMap
forall k a. Map k a
M.empty
Bool
False) { progress :: ProgressMessage -> Make ()
P.progress = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()) }
filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
filePathMap :: Map ModuleName (Either RebuildPolicy FilePath)
filePathMap = forall k a. k -> a -> Map k a
M.singleton (Module -> ModuleName
P.getModuleName Module
m) (forall a b. a -> Either a b
Left RebuildPolicy
P.RebuildAlways)
make
:: [(FilePath, CST.PartialResult P.Module)]
-> P.Make ([P.ExternsFile], P.Environment)
make :: [(FilePath, PartialResult Module)]
-> Make ([ExternsFile], Environment)
make [(FilePath, PartialResult Module)]
ms = do
Map ModuleName FilePath
foreignFiles <- forall (m :: * -> *).
MonadIO m =>
Map ModuleName (Either RebuildPolicy FilePath)
-> m (Map ModuleName FilePath)
P.inferForeignModules Map ModuleName (Either RebuildPolicy FilePath)
filePathMap
[ExternsFile]
externs <- forall (m :: * -> *).
(Monad m, MonadBaseControl IO m, MonadError MultipleErrors m,
MonadWriter MultipleErrors m) =>
MakeActions m -> [PartialResult Module] -> m [ExternsFile]
P.make (Map ModuleName FilePath -> MakeActions Make
buildActions Map ModuleName FilePath
foreignFiles) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(FilePath, PartialResult Module)]
ms)
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExternsFile]
externs, forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip ExternsFile -> Environment -> Environment
P.applyExternsFileToEnvironment) Environment
P.initEnvironment [ExternsFile]
externs)
where
buildActions :: M.Map P.ModuleName FilePath -> P.MakeActions P.Make
buildActions :: Map ModuleName FilePath -> MakeActions Make
buildActions Map ModuleName FilePath
foreignFiles =
FilePath
-> Map ModuleName (Either RebuildPolicy FilePath)
-> Map ModuleName FilePath
-> Bool
-> MakeActions Make
P.buildMakeActions FilePath
modulesDir
Map ModuleName (Either RebuildPolicy FilePath)
filePathMap
Map ModuleName FilePath
foreignFiles
Bool
False
filePathMap :: M.Map P.ModuleName (Either P.RebuildPolicy FilePath)
filePathMap :: Map ModuleName (Either RebuildPolicy FilePath)
filePathMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
fp, PartialResult Module
m) -> (Module -> ModuleName
P.getModuleName forall a b. (a -> b) -> a -> b
$ forall a. PartialResult a -> a
CST.resPartial PartialResult Module
m, forall a b. b -> Either a b
Right FilePath
fp)) [(FilePath, PartialResult Module)]
ms
handleCommand
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> m ()
-> (String -> m ())
-> Command
-> m ()
handleCommand :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m () -> (FilePath -> m ()) -> Command -> m ()
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p Command
ShowHelp = FilePath -> m ()
p FilePath
helpMessage
handleCommand FilePath -> m ()
_ m ()
r FilePath -> m ()
_ Command
ReloadState = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
m () -> m ()
handleReloadState m ()
r
handleCommand FilePath -> m ()
_ m ()
r FilePath -> m ()
_ Command
ClearState = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
m () -> m ()
handleClearState m ()
r
handleCommand FilePath -> m ()
e m ()
_ FilePath -> m ()
_ (Expression Expr
val) = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> Expr -> m ()
handleExpression FilePath -> m ()
e Expr
val
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
_ (Import ImportedModule
im) = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
ImportedModule -> m ()
handleImport ImportedModule
im
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
_ (Decls [Declaration]
l) = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
[Declaration] -> m ()
handleDecls [Declaration]
l
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (TypeOf Expr
val) = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> Expr -> m ()
handleTypeOf FilePath -> m ()
p Expr
val
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (KindOf SourceType
typ) = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> SourceType -> m ()
handleKindOf FilePath -> m ()
p SourceType
typ
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (BrowseModule ModuleName
moduleName) = forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> ModuleName -> m ()
handleBrowse FilePath -> m ()
p ModuleName
moduleName
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (ShowInfo ReplQuery
QueryLoaded) = forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m ()
handleShowLoadedModules FilePath -> m ()
p
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (ShowInfo ReplQuery
QueryImport) = forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m ()
handleShowImportedModules FilePath -> m ()
p
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (ShowInfo ReplQuery
QueryPrint) = forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m ()
handleShowPrint FilePath -> m ()
p
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (CompleteStr FilePath
prefix) = forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> FilePath -> m ()
handleComplete FilePath -> m ()
p FilePath
prefix
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
p (SetInteractivePrint (ModuleName, Ident)
ip) = forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> (ModuleName, Ident) -> m ()
handleSetInteractivePrint FilePath -> m ()
p (ModuleName, Ident)
ip
handleCommand FilePath -> m ()
_ m ()
_ FilePath -> m ()
_ Command
_ = forall a. HasCallStack => FilePath -> a
P.internalError FilePath
"handleCommand: unexpected command"
handleReloadState
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> m ()
-> m ()
handleReloadState :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
m () -> m ()
handleReloadState m ()
reload = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ ([Declaration] -> [Declaration]) -> PSCiState -> PSCiState
updateLets (forall a b. a -> b -> a
const [])
[FilePath]
globs <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PSCiConfig -> [FilePath]
psciFileGlobs
[FilePath]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 FilePath -> IO [FilePath]
glob [FilePath]
globs
Either MultipleErrors ([Module], [ExternsFile])
e <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
[(FilePath, Module)]
modules <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [FilePath] -> IO (Either MultipleErrors [(FilePath, Module)])
loadAllModules [FilePath]
files
([ExternsFile]
externs, Environment
_) <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(FilePath, PartialResult Module)]
-> Make ([ExternsFile], Environment)
make forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> PartialResult a
CST.pureResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(FilePath, Module)]
modules
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(FilePath, Module)]
modules, [ExternsFile]
externs)
case Either MultipleErrors ([Module], [ExternsFile])
e of
Left MultipleErrors
errs -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs
Right ([Module]
modules, [ExternsFile]
externs) -> do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([(Module, ExternsFile)] -> [(Module, ExternsFile)])
-> PSCiState -> PSCiState
updateLoadedExterns (forall a b. a -> b -> a
const (forall a b. [a] -> [b] -> [(a, b)]
zip [Module]
modules [ExternsFile]
externs)))
m ()
reload
handleClearState
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> m ()
-> m ()
handleClearState :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
m () -> m ()
handleClearState m ()
reload = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ ([ImportedModule] -> [ImportedModule]) -> PSCiState -> PSCiState
updateImportedModules (forall a b. a -> b -> a
const [])
forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
m () -> m ()
handleReloadState m ()
reload
handleExpression
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> P.Expr
-> m ()
handleExpression :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> Expr -> m ()
handleExpression FilePath -> m ()
evaluate Expr
val = do
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let m :: Module
m = Bool -> PSCiState -> Expr -> Module
createTemporaryModule Bool
True PSCiState
st Expr
val
Either MultipleErrors (ExternsFile, Environment)
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall a b. (a -> b) -> a -> b
$ [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)) Module
m
case Either MultipleErrors (ExternsFile, Environment)
e of
Left MultipleErrors
errs -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs
Right (ExternsFile, Environment)
_ -> do
FilePath
js <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readFile (FilePath
modulesDir FilePath -> FilePath -> FilePath
</> FilePath
"$PSCI" FilePath -> FilePath -> FilePath
</> FilePath
"index.js")
FilePath -> m ()
evaluate FilePath
js
handleDecls
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> [P.Declaration]
-> m ()
handleDecls :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
[Declaration] -> m ()
handleDecls [Declaration]
ds = do
PSCiState
st <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (([Declaration] -> [Declaration]) -> PSCiState -> PSCiState
updateLets (forall a. [a] -> [a] -> [a]
++ [Declaration]
ds))
let m :: Module
m = Bool -> PSCiState -> Expr -> Module
createTemporaryModule Bool
False PSCiState
st (SourceSpan -> Literal Expr -> Expr
P.Literal SourceSpan
P.nullSourceSpan (forall a. [(PSString, a)] -> Literal a
P.ObjectLiteral []))
Either MultipleErrors (ExternsFile, Environment)
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall a b. (a -> b) -> a -> b
$ [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)) Module
m
case Either MultipleErrors (ExternsFile, Environment)
e of
Left MultipleErrors
err -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
err
Right (ExternsFile, Environment)
_ -> forall s (m :: * -> *). MonadState s m => s -> m ()
put PSCiState
st
handleShowLoadedModules
:: (MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> m ()
handleShowLoadedModules :: forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m ()
handleShowLoadedModules FilePath -> m ()
print' = do
[(Module, ExternsFile)]
loadedModules <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns
FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$ forall {b}. [(Module, b)] -> FilePath
readModules [(Module, ExternsFile)]
loadedModules
where
readModules :: [(Module, b)] -> FilePath
readModules = [FilePath] -> FilePath
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> FilePath
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
handleShowImportedModules
:: (MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> m ()
handleShowImportedModules :: forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m ()
handleShowImportedModules FilePath -> m ()
print' = do
[ImportedModule]
importedModules <- PSCiState -> [ImportedModule]
psciImportedModules forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$ [ImportedModule] -> FilePath
showModules [ImportedModule]
importedModules
where
showModules :: [ImportedModule] -> FilePath
showModules = [FilePath] -> FilePath
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}.
Foldable t =>
(ModuleName, ImportDeclarationType, t ModuleName) -> Text
showModule)
showModule :: (ModuleName, ImportDeclarationType, t ModuleName) -> Text
showModule (ModuleName
mn, ImportDeclarationType
declType, t ModuleName
asQ) =
Text
"import " forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
N.runModuleName ModuleName
mn forall a. Semigroup a => a -> a -> a
<> ImportDeclarationType -> Text
showDeclType ImportDeclarationType
declType forall a. Semigroup a => a -> a -> a
<>
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ModuleName
mn' -> Text
" as " forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
N.runModuleName ModuleName
mn') t ModuleName
asQ
showDeclType :: ImportDeclarationType -> Text
showDeclType ImportDeclarationType
P.Implicit = Text
""
showDeclType (P.Explicit [DeclarationRef]
refs) = [DeclarationRef] -> Text
refsList [DeclarationRef]
refs
showDeclType (P.Hiding [DeclarationRef]
refs) = Text
" hiding " forall a. Semigroup a => a -> a -> a
<> [DeclarationRef] -> Text
refsList [DeclarationRef]
refs
refsList :: [DeclarationRef] -> Text
refsList [DeclarationRef]
refs = Text
" (" forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
commaList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe Text
showRef [DeclarationRef]
refs) forall a. Semigroup a => a -> a -> a
<> Text
")"
showRef :: P.DeclarationRef -> Maybe Text
showRef :: DeclarationRef -> Maybe Text
showRef (P.TypeRef SourceSpan
_ ProperName 'TypeName
pn Maybe [ProperName 'ConstructorName]
dctors) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (a :: ProperNameType). ProperName a -> Text
N.runProperName ProperName 'TypeName
pn forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
".." ([Text] -> Text
commaList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (a :: ProperNameType). ProperName a -> Text
N.runProperName) Maybe [ProperName 'ConstructorName]
dctors forall a. Semigroup a => a -> a -> a
<> Text
")"
showRef (P.TypeOpRef SourceSpan
_ OpName 'TypeOpName
op) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
"type " forall a. Semigroup a => a -> a -> a
<> forall (a :: OpNameType). OpName a -> Text
N.showOp OpName 'TypeOpName
op
showRef (P.ValueRef SourceSpan
_ Ident
ident) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ident -> Text
N.runIdent Ident
ident
showRef (P.ValueOpRef SourceSpan
_ OpName 'ValueOpName
op) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (a :: OpNameType). OpName a -> Text
N.showOp OpName 'ValueOpName
op
showRef (P.TypeClassRef SourceSpan
_ ProperName 'ClassName
pn) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
"class " forall a. Semigroup a => a -> a -> a
<> forall (a :: ProperNameType). ProperName a -> Text
N.runProperName ProperName 'ClassName
pn
showRef (P.TypeInstanceRef SourceSpan
_ Ident
ident NameSource
P.UserNamed) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Ident -> Text
N.runIdent Ident
ident
showRef (P.TypeInstanceRef SourceSpan
_ Ident
_ NameSource
P.CompilerNamed) =
forall a. Maybe a
Nothing
showRef (P.ModuleRef SourceSpan
_ ModuleName
name) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
"module " forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
N.runModuleName ModuleName
name
showRef (P.ReExportRef SourceSpan
_ ExportSource
_ DeclarationRef
_) =
forall a. Maybe a
Nothing
commaList :: [Text] -> Text
commaList :: [Text] -> Text
commaList = Text -> [Text] -> Text
T.intercalate Text
", "
handleShowPrint
:: (MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> m ()
handleShowPrint :: forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> m ()
handleShowPrint FilePath -> m ()
print' = do
(ModuleName, Ident)
current <- PSCiState -> (ModuleName, Ident)
psciInteractivePrint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
if (ModuleName, Ident)
current forall a. Eq a => a -> a -> Bool
== (ModuleName, Ident)
initialInteractivePrint
then
FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$
FilePath
"The interactive print function is currently set to the default (`" forall a. [a] -> [a] -> [a]
++ (ModuleName, Ident) -> FilePath
showPrint (ModuleName, Ident)
current forall a. [a] -> [a] -> [a]
++ FilePath
"`)"
else
FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$
FilePath
"The interactive print function is currently set to `" forall a. [a] -> [a] -> [a]
++ (ModuleName, Ident) -> FilePath
showPrint (ModuleName, Ident)
current forall a. [a] -> [a] -> [a]
++ FilePath
"`\n" forall a. [a] -> [a] -> [a]
++
FilePath
"The default can be restored with `:print " forall a. [a] -> [a] -> [a]
++ (ModuleName, Ident) -> FilePath
showPrint (ModuleName, Ident)
initialInteractivePrint forall a. [a] -> [a] -> [a]
++ FilePath
"`"
where
showPrint :: (ModuleName, Ident) -> FilePath
showPrint (ModuleName
mn, Ident
ident) = Text -> FilePath
T.unpack (ModuleName -> Text
N.runModuleName ModuleName
mn forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Ident -> Text
N.runIdent Ident
ident)
handleImport
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> ImportedModule
-> m ()
handleImport :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
ImportedModule -> m ()
handleImport ImportedModule
im = do
PSCiState
st <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (([ImportedModule] -> [ImportedModule]) -> PSCiState -> PSCiState
updateImportedModules (ImportedModule
im forall a. a -> [a] -> [a]
:))
let m :: Module
m = PSCiState -> Module
createTemporaryModuleForImports PSCiState
st
Either MultipleErrors (ExternsFile, Environment)
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall a b. (a -> b) -> a -> b
$ [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)) Module
m
case Either MultipleErrors (ExternsFile, Environment)
e of
Left MultipleErrors
errs -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs
Right (ExternsFile, Environment)
_ -> forall s (m :: * -> *). MonadState s m => s -> m ()
put PSCiState
st
handleTypeOf
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> P.Expr
-> m ()
handleTypeOf :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> Expr -> m ()
handleTypeOf FilePath -> m ()
print' Expr
val = do
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let m :: Module
m = Bool -> PSCiState -> Expr -> Module
createTemporaryModule Bool
False PSCiState
st Expr
val
Either MultipleErrors (ExternsFile, Environment)
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall a b. (a -> b) -> a -> b
$ [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)) Module
m
case Either MultipleErrors (ExternsFile, Environment)
e of
Left MultipleErrors
errs -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs
Right (ExternsFile
_, Environment
env') ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. a -> ModuleName -> Qualified a
P.mkQualified (Text -> Ident
P.Ident Text
"it") (Text -> ModuleName
P.ModuleName Text
"$PSCI")) (Environment
-> Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
P.names Environment
env') of
Just (SourceType
ty, NameKind
_, NameVisibility
_) -> FilePath -> m ()
print' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Type a -> FilePath
P.prettyPrintType forall a. Bounded a => a
maxBound forall a b. (a -> b) -> a -> b
$ SourceType
ty
Maybe (SourceType, NameKind, NameVisibility)
Nothing -> FilePath -> m ()
print' FilePath
"Could not find type"
handleKindOf
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> P.SourceType
-> m ()
handleKindOf :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> SourceType -> m ()
handleKindOf FilePath -> m ()
print' SourceType
typ = do
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let m :: Module
m = PSCiState -> SourceType -> Module
createTemporaryModuleForKind PSCiState
st SourceType
typ
mName :: ModuleName
mName = Text -> ModuleName
P.ModuleName Text
"$PSCI"
Either MultipleErrors (ExternsFile, Environment)
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall a b. (a -> b) -> a -> b
$ [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)) Module
m
case Either MultipleErrors (ExternsFile, Environment)
e of
Left MultipleErrors
errs -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs
Right (ExternsFile
_, Environment
env') ->
case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall a. QualifiedBy -> a -> Qualified a
P.Qualified (ModuleName -> QualifiedBy
P.ByModuleName ModuleName
mName) forall a b. (a -> b) -> a -> b
$ forall (a :: ProperNameType). Text -> ProperName a
P.ProperName Text
"IT") (Environment
-> Map
(Qualified (ProperName 'TypeName))
([(Text, Maybe SourceType)], SourceType)
P.typeSynonyms Environment
env') of
Just ([(Text, Maybe SourceType)]
_, SourceType
typ') -> do
let chk :: CheckState
chk = (Environment -> CheckState
P.emptyCheckState Environment
env') { checkCurrentModule :: Maybe ModuleName
P.checkCurrentModule = forall a. a -> Maybe a
Just ModuleName
mName }
k :: Either MultipleErrors (SourceType, CheckState)
k = forall a.
StateT
CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a
-> CheckState -> Either MultipleErrors (a, CheckState)
check (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
(MonadError MultipleErrors m, MonadState CheckState m,
HasCallStack) =>
SourceType -> m (SourceType, SourceType)
P.kindOf SourceType
typ') CheckState
chk
check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)
check :: forall a.
StateT
CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a
-> CheckState -> Either MultipleErrors (a, CheckState)
check StateT
CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a
sew = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w a. Writer w a -> (a, w)
runWriter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT
CheckState (ExceptT MultipleErrors (Writer MultipleErrors)) a
sew
case Either MultipleErrors (SourceType, CheckState)
k of
Left MultipleErrors
err -> forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
err
Right (SourceType
kind, CheckState
_) -> FilePath -> m ()
print' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> Type a -> FilePath
P.prettyPrintType Int
1024 forall a b. (a -> b) -> a -> b
$ SourceType
kind
Maybe ([(Text, Maybe SourceType)], SourceType)
Nothing -> FilePath -> m ()
print' FilePath
"Could not find kind"
handleBrowse
:: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> P.ModuleName
-> m ()
handleBrowse :: forall (m :: * -> *).
(MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> ModuleName -> m ()
handleBrowse FilePath -> m ()
print' ModuleName
moduleName = do
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let env :: Environment
env = PSCiState -> Environment
psciEnvironment PSCiState
st
case forall {t :: * -> *} {b} {b}.
Foldable t =>
ModuleName
-> [(Module, b)]
-> t (ModuleName, b, Maybe ModuleName)
-> Maybe ModuleName
findMod ModuleName
moduleName (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st) (PSCiState -> [ImportedModule]
psciImportedModules PSCiState
st) of
Just ModuleName
qualName -> FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$ ModuleName -> Environment -> FilePath
printModuleSignatures ModuleName
qualName Environment
env
Maybe ModuleName
Nothing -> ModuleName -> m ()
failNotInEnv ModuleName
moduleName
where
findMod :: ModuleName
-> [(Module, b)]
-> t (ModuleName, b, Maybe ModuleName)
-> Maybe ModuleName
findMod ModuleName
needle [(Module, b)]
externs t (ModuleName, b, Maybe ModuleName)
imports =
let qualMod :: ModuleName
qualMod = forall a. a -> Maybe a -> a
fromMaybe ModuleName
needle (forall {t :: * -> *} {a} {b} {b}.
(Foldable t, Eq a) =>
a -> t (b, b, Maybe a) -> Maybe b
lookupUnQualifiedModName ModuleName
needle t (ModuleName, b, Maybe ModuleName)
imports)
modules :: Set ModuleName
modules = forall a. Ord a => [a] -> Set a
S.fromList ([ModuleName]
C.primModules forall a. Semigroup a => a -> a -> a
<> (Module -> ModuleName
P.getModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Module, b)]
externs))
in if ModuleName
qualMod forall a. Ord a => a -> Set a -> Bool
`S.member` Set ModuleName
modules
then forall a. a -> Maybe a
Just ModuleName
qualMod
else forall a. Maybe a
Nothing
failNotInEnv :: ModuleName -> m ()
failNotInEnv ModuleName
modName = FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"Module '" forall a. Semigroup a => a -> a -> a
<> ModuleName -> Text
N.runModuleName ModuleName
modName forall a. Semigroup a => a -> a -> a
<> Text
"' is not valid."
lookupUnQualifiedModName :: a -> t (b, b, Maybe a) -> Maybe b
lookupUnQualifiedModName a
needle t (b, b, Maybe a)
imports =
(\(b
modName,b
_,Maybe a
_) -> b
modName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(b
_,b
_,Maybe a
mayQuaName) -> Maybe a
mayQuaName forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just a
needle) t (b, b, Maybe a)
imports
handleComplete
:: (MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> String
-> m ()
handleComplete :: forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> FilePath -> m ()
handleComplete FilePath -> m ()
print' FilePath
prefix = do
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let act :: StateT PSCiState m (FilePath, [Completion])
act = forall (m :: * -> *) a.
(MonadState PSCiState m, MonadIO m) =>
CompletionM a -> m a
liftCompletionM (CompletionFunc CompletionM
completion' (forall a. [a] -> [a]
reverse FilePath
prefix, FilePath
""))
(FilePath, [Completion])
results <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT PSCiState m (FilePath, [Completion])
act PSCiState
st
FilePath -> m ()
print' forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ((FilePath, [Completion]) -> [FilePath]
formatCompletions (FilePath, [Completion])
results)
handleSetInteractivePrint
:: (MonadState PSCiState m, MonadIO m)
=> (String -> m ())
-> (P.ModuleName, P.Ident)
-> m ()
handleSetInteractivePrint :: forall (m :: * -> *).
(MonadState PSCiState m, MonadIO m) =>
(FilePath -> m ()) -> (ModuleName, Ident) -> m ()
handleSetInteractivePrint FilePath -> m ()
print' (ModuleName, Ident)
new = do
(ModuleName, Ident)
current <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PSCiState -> (ModuleName, Ident)
psciInteractivePrint
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleName, Ident) -> PSCiState -> PSCiState
setInteractivePrint (ModuleName, Ident)
new)
PSCiState
st <- forall s (m :: * -> *). MonadState s m => m s
get
let expr :: Expr
expr = SourceSpan -> Literal Expr -> Expr
P.Literal SourceSpan
internalSpan (forall a. Either Integer Double -> Literal a
P.NumericLiteral (forall a b. a -> Either a b
Left Integer
0))
let m :: Module
m = Bool -> PSCiState -> Expr -> Module
createTemporaryModule Bool
True PSCiState
st Expr
expr
Either MultipleErrors (ExternsFile, Environment)
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Make a -> IO (Either MultipleErrors a)
runMake forall a b. (a -> b) -> a -> b
$ [ExternsFile] -> Module -> Make (ExternsFile, Environment)
rebuild (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)) Module
m
case Either MultipleErrors (ExternsFile, Environment)
e of
Left MultipleErrors
errs -> do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ModuleName, Ident) -> PSCiState -> PSCiState
setInteractivePrint (ModuleName, Ident)
current)
FilePath -> m ()
print' FilePath
"Unable to set the repl's printing function:"
forall (m :: * -> *). MonadIO m => MultipleErrors -> m ()
printErrors MultipleErrors
errs
Right (ExternsFile, Environment)
_ ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()