{-# LANGUAGE DoAndIfThenElse #-}

module Language.PureScript.Interactive
  ( handleCommand
  , module Interactive

  -- TODO: remove these exports
  , 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)

-- | Pretty-print errors
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

-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
-- options and ignores the warning messages.
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 a module, using the cached externs data for dependencies.
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)

-- | Build the collection of modules from scratch. This is usually done on startup.
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

-- | Performs a PSCi command
handleCommand
  :: (MonadReader PSCiConfig m, MonadState PSCiState m, MonadIO m)
  => (String -> m ()) -- ^ evaluate JS
  -> m () -- ^ reload
  -> (String -> m ()) -- ^ print into console
  -> 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"

-- | Reload the application state
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

-- | Clear the application state
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

-- | Takes a value expression and evaluates it with the current state.
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

-- |
-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
-- restore the original environment.
--
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

-- | Show actual loaded modules in psci.
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)

-- | Show the imported modules in psci.
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)

-- | Imports a module, preserving the initial state on failure.
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

-- | Takes a value and prints its type
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"

-- | Takes a type and prints its kind
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"

-- | Browse a module and displays its signature
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

-- | Return output as would be returned by tab completion, for tools integration etc.
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)

-- | Attempt to set the interactive print function. Note that the state will
-- only be updated if the interactive print function exists and appears to
-- work; we test it by attempting to evaluate '0'.
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 ()