-- |
-- Type declarations and associated basic functions for PSCI.
--
module Language.PureScript.Interactive.Types
  ( PSCiConfig(..)
  , psciEnvironment
  , PSCiState -- constructor is not exported, to prevent psciImports and psciExports from
              -- becoming inconsistent with importedModules, letBindings and loadedExterns
  , ImportedModule
  , psciExports
  , psciImports
  , psciLoadedExterns
  , psciInteractivePrint
  , psciImportedModules
  , psciLetBindings
  , initialPSCiState
  , initialInteractivePrint
  , updateImportedModules
  , updateLoadedExterns
  , updateLets
  , setInteractivePrint
  , Command(..)
  , ReplQuery(..)
  , replQueries
  , replQueryStrings
  , showReplQuery
  , parseReplQuery
  , Directive(..)
  ) where

import Prelude

import qualified Language.PureScript as P
import qualified Data.Map as M
import           Data.List (foldl')
import           Language.PureScript.Sugar.Names.Env (nullImports, primExports)
import           Control.Monad (foldM)
import           Control.Monad.Trans.Except (runExceptT)
import           Control.Monad.Trans.State (execStateT)
import           Control.Monad.Writer.Strict (runWriterT)


-- | The PSCI configuration.
--
-- These configuration values do not change during execution.
--
newtype PSCiConfig = PSCiConfig
  { PSCiConfig -> [String]
psciFileGlobs :: [String]
  } deriving Int -> PSCiConfig -> ShowS
[PSCiConfig] -> ShowS
PSCiConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSCiConfig] -> ShowS
$cshowList :: [PSCiConfig] -> ShowS
show :: PSCiConfig -> String
$cshow :: PSCiConfig -> String
showsPrec :: Int -> PSCiConfig -> ShowS
$cshowsPrec :: Int -> PSCiConfig -> ShowS
Show

-- | The PSCI state.
--
-- Holds a list of imported modules, loaded files, and partial let bindings,
-- plus the currently configured interactive printing function.
--
-- The let bindings are partial, because it makes more sense to apply the
-- binding to the final evaluated expression.
--
-- The last two fields are derived from the first three via updateImportExports
-- each time a module is imported, a let binding is added, or the session is
-- cleared or reloaded
data PSCiState = PSCiState
  [ImportedModule]
  [P.Declaration]
  [(P.Module, P.ExternsFile)]
  (P.ModuleName, P.Ident)
  P.Imports
  P.Exports
  deriving Int -> PSCiState -> ShowS
[PSCiState] -> ShowS
PSCiState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PSCiState] -> ShowS
$cshowList :: [PSCiState] -> ShowS
show :: PSCiState -> String
$cshow :: PSCiState -> String
showsPrec :: Int -> PSCiState -> ShowS
$cshowsPrec :: Int -> PSCiState -> ShowS
Show

psciImportedModules :: PSCiState -> [ImportedModule]
psciImportedModules :: PSCiState -> [ImportedModule]
psciImportedModules (PSCiState [ImportedModule]
x [Declaration]
_ [(Module, ExternsFile)]
_ (ModuleName, Ident)
_ Imports
_ Exports
_) = [ImportedModule]
x

psciLetBindings :: PSCiState -> [P.Declaration]
psciLetBindings :: PSCiState -> [Declaration]
psciLetBindings (PSCiState [ImportedModule]
_ [Declaration]
x [(Module, ExternsFile)]
_ (ModuleName, Ident)
_ Imports
_ Exports
_) = [Declaration]
x

psciLoadedExterns :: PSCiState -> [(P.Module, P.ExternsFile)]
psciLoadedExterns :: PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns (PSCiState [ImportedModule]
_ [Declaration]
_ [(Module, ExternsFile)]
x (ModuleName, Ident)
_ Imports
_ Exports
_) = [(Module, ExternsFile)]
x

psciInteractivePrint :: PSCiState -> (P.ModuleName, P.Ident)
psciInteractivePrint :: PSCiState -> (ModuleName, Ident)
psciInteractivePrint (PSCiState [ImportedModule]
_ [Declaration]
_ [(Module, ExternsFile)]
_ (ModuleName, Ident)
x Imports
_ Exports
_) = (ModuleName, Ident)
x

psciImports :: PSCiState -> P.Imports
psciImports :: PSCiState -> Imports
psciImports (PSCiState [ImportedModule]
_ [Declaration]
_ [(Module, ExternsFile)]
_ (ModuleName, Ident)
_ Imports
x Exports
_) = Imports
x

psciExports :: PSCiState -> P.Exports
psciExports :: PSCiState -> Exports
psciExports (PSCiState [ImportedModule]
_ [Declaration]
_ [(Module, ExternsFile)]
_ (ModuleName, Ident)
_ Imports
_ Exports
x) = Exports
x

initialPSCiState :: PSCiState
initialPSCiState :: PSCiState
initialPSCiState = [ImportedModule]
-> [Declaration]
-> [(Module, ExternsFile)]
-> (ModuleName, Ident)
-> Imports
-> Exports
-> PSCiState
PSCiState [] [] [] (ModuleName, Ident)
initialInteractivePrint Imports
nullImports Exports
primExports

-- | The default interactive print function.
initialInteractivePrint :: (P.ModuleName, P.Ident)
initialInteractivePrint :: (ModuleName, Ident)
initialInteractivePrint = (Text -> ModuleName
P.moduleNameFromString Text
"PSCI.Support", Text -> Ident
P.Ident Text
"eval")

psciEnvironment :: PSCiState -> P.Environment
psciEnvironment :: PSCiState -> Environment
psciEnvironment PSCiState
st = 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 externs :: [ExternsFile]
externs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (PSCiState -> [(Module, ExternsFile)]
psciLoadedExterns PSCiState
st)

-- | All of the data that is contained by an ImportDeclaration in the AST.
-- That is:
--
-- * A module name, the name of the module which is being imported
-- * An ImportDeclarationType which specifies whether there is an explicit
--   import list, a hiding list, or neither.
-- * If the module is imported qualified, its qualified name in the importing
--   module. Otherwise, Nothing.
--
type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)

-- * State helpers

-- This function updates the Imports and Exports values in the PSCiState, which are used for
-- handling completions. This function must be called whenever the PSCiState is modified to
-- ensure that completions remain accurate.
updateImportExports :: PSCiState -> PSCiState
updateImportExports :: PSCiState -> PSCiState
updateImportExports st :: PSCiState
st@(PSCiState [ImportedModule]
modules [Declaration]
lets [(Module, ExternsFile)]
externs (ModuleName, Ident)
iprint Imports
_ Exports
_) =
  case [ExternsFile] -> Either MultipleErrors Env
createEnv (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Module, ExternsFile)]
externs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip Env -> Module -> Either MultipleErrors Env
desugarModule Module
temporaryModule of
    Left MultipleErrors
_          -> PSCiState
st -- TODO: can this fail and what should we do?
    Right Env
env  ->
      case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
temporaryName Env
env of
        Just (SourceSpan
_, Imports
is, Exports
es)  -> [ImportedModule]
-> [Declaration]
-> [(Module, ExternsFile)]
-> (ModuleName, Ident)
-> Imports
-> Exports
-> PSCiState
PSCiState [ImportedModule]
modules [Declaration]
lets [(Module, ExternsFile)]
externs (ModuleName, Ident)
iprint Imports
is Exports
es
        Maybe (SourceSpan, Imports, Exports)
_                 -> PSCiState
st -- impossible
  where

  desugarModule :: P.Env -> P.Module -> Either P.MultipleErrors P.Env
  desugarModule :: Env -> Module -> Either MultipleErrors Env
desugarModule Env
e = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (Env
e, forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m,
 MonadState (Env, UsedImports) m) =>
Module -> m Module
P.desugarImports

  createEnv :: [P.ExternsFile] -> Either P.MultipleErrors P.Env
  createEnv :: [ExternsFile] -> Either MultipleErrors Env
createEnv = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall (m :: * -> *).
(MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
Env -> ExternsFile -> m Env
P.externsEnv Env
P.primEnv

  temporaryName :: P.ModuleName
  temporaryName :: ModuleName
temporaryName = Text -> ModuleName
P.ModuleName Text
"$PSCI"

  temporaryModule :: P.Module
  temporaryModule :: Module
temporaryModule =
    let
      prim :: (ModuleName, ImportDeclarationType, Maybe a)
prim = (Text -> ModuleName
P.ModuleName Text
"Prim", ImportDeclarationType
P.Implicit, forall a. Maybe a
Nothing)
      decl :: [Declaration]
decl = (ImportedModule -> Declaration
importDecl forall a b. (a -> b) -> [a] -> [b]
`map` (forall {a}. (ModuleName, ImportDeclarationType, Maybe a)
prim forall a. a -> [a] -> [a]
: [ImportedModule]
modules)) forall a. [a] -> [a] -> [a]
++ [Declaration]
lets
    in
      SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
P.Module SourceSpan
internalSpan [] ModuleName
temporaryName [Declaration]
decl forall a. Maybe a
Nothing

  importDecl :: ImportedModule -> P.Declaration
  importDecl :: ImportedModule -> Declaration
importDecl (ModuleName
mn, ImportDeclarationType
declType, Maybe ModuleName
asQ) = SourceAnn
-> ModuleName
-> ImportDeclarationType
-> Maybe ModuleName
-> Declaration
P.ImportDeclaration (SourceSpan
internalSpan, []) ModuleName
mn ImportDeclarationType
declType Maybe ModuleName
asQ

  internalSpan :: P.SourceSpan
  internalSpan :: SourceSpan
internalSpan = String -> SourceSpan
P.internalModuleSourceSpan String
"<internal>"

-- | Updates the imported modules in the state record.
updateImportedModules :: ([ImportedModule] -> [ImportedModule]) -> PSCiState -> PSCiState
updateImportedModules :: ([ImportedModule] -> [ImportedModule]) -> PSCiState -> PSCiState
updateImportedModules [ImportedModule] -> [ImportedModule]
f (PSCiState [ImportedModule]
x [Declaration]
a [(Module, ExternsFile)]
b (ModuleName, Ident)
c Imports
d Exports
e) =
  PSCiState -> PSCiState
updateImportExports ([ImportedModule]
-> [Declaration]
-> [(Module, ExternsFile)]
-> (ModuleName, Ident)
-> Imports
-> Exports
-> PSCiState
PSCiState ([ImportedModule] -> [ImportedModule]
f [ImportedModule]
x) [Declaration]
a [(Module, ExternsFile)]
b (ModuleName, Ident)
c Imports
d Exports
e)

-- | Updates the loaded externs files in the state record.
updateLoadedExterns :: ([(P.Module, P.ExternsFile)] -> [(P.Module, P.ExternsFile)]) -> PSCiState -> PSCiState
updateLoadedExterns :: ([(Module, ExternsFile)] -> [(Module, ExternsFile)])
-> PSCiState -> PSCiState
updateLoadedExterns [(Module, ExternsFile)] -> [(Module, ExternsFile)]
f (PSCiState [ImportedModule]
a [Declaration]
b [(Module, ExternsFile)]
x (ModuleName, Ident)
c Imports
d Exports
e) =
  PSCiState -> PSCiState
updateImportExports ([ImportedModule]
-> [Declaration]
-> [(Module, ExternsFile)]
-> (ModuleName, Ident)
-> Imports
-> Exports
-> PSCiState
PSCiState [ImportedModule]
a [Declaration]
b ([(Module, ExternsFile)] -> [(Module, ExternsFile)]
f [(Module, ExternsFile)]
x) (ModuleName, Ident)
c Imports
d Exports
e)

-- | Updates the let bindings in the state record.
updateLets :: ([P.Declaration] -> [P.Declaration]) -> PSCiState -> PSCiState
updateLets :: ([Declaration] -> [Declaration]) -> PSCiState -> PSCiState
updateLets [Declaration] -> [Declaration]
f (PSCiState [ImportedModule]
a [Declaration]
x [(Module, ExternsFile)]
b (ModuleName, Ident)
c Imports
d Exports
e) =
  PSCiState -> PSCiState
updateImportExports ([ImportedModule]
-> [Declaration]
-> [(Module, ExternsFile)]
-> (ModuleName, Ident)
-> Imports
-> Exports
-> PSCiState
PSCiState [ImportedModule]
a ([Declaration] -> [Declaration]
f [Declaration]
x) [(Module, ExternsFile)]
b (ModuleName, Ident)
c Imports
d Exports
e)

-- | Replaces the interactive printing function in the state record with a new
-- one.
setInteractivePrint :: (P.ModuleName, P.Ident) -> PSCiState -> PSCiState
setInteractivePrint :: (ModuleName, Ident) -> PSCiState -> PSCiState
setInteractivePrint (ModuleName, Ident)
iprint (PSCiState [ImportedModule]
a [Declaration]
b [(Module, ExternsFile)]
c (ModuleName, Ident)
_ Imports
d Exports
e) =
  [ImportedModule]
-> [Declaration]
-> [(Module, ExternsFile)]
-> (ModuleName, Ident)
-> Imports
-> Exports
-> PSCiState
PSCiState [ImportedModule]
a [Declaration]
b [(Module, ExternsFile)]
c (ModuleName, Ident)
iprint Imports
d Exports
e

-- * Commands

-- |
-- Valid Meta-commands for PSCI
--
data Command
  -- | A purescript expression
  = Expression P.Expr
  -- | Show the help (ie, list of directives)
  | ShowHelp
  -- | Import a module from a loaded file
  | Import ImportedModule
  -- | Browse a module
  | BrowseModule P.ModuleName
  -- | Exit PSCI
  | QuitPSCi
  -- | Reload all the imported modules of the REPL
  | ReloadState
  -- | Clear the state of the REPL
  | ClearState
  -- | Add some declarations to the current evaluation context
  | Decls [P.Declaration]
  -- | Find the type of an expression
  | TypeOf P.Expr
  -- | Find the kind of an expression
  | KindOf P.SourceType
  -- | Shows information about the current state of the REPL
  | ShowInfo ReplQuery
  -- | Paste multiple lines
  | PasteLines
  -- | Return auto-completion output as if pressing <tab>
  | CompleteStr String
  -- | Set the interactive printing function
  | SetInteractivePrint (P.ModuleName, P.Ident)
  deriving Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show

data ReplQuery
  = QueryLoaded
  | QueryImport
  | QueryPrint
  deriving (ReplQuery -> ReplQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplQuery -> ReplQuery -> Bool
$c/= :: ReplQuery -> ReplQuery -> Bool
== :: ReplQuery -> ReplQuery -> Bool
$c== :: ReplQuery -> ReplQuery -> Bool
Eq, Int -> ReplQuery -> ShowS
[ReplQuery] -> ShowS
ReplQuery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplQuery] -> ShowS
$cshowList :: [ReplQuery] -> ShowS
show :: ReplQuery -> String
$cshow :: ReplQuery -> String
showsPrec :: Int -> ReplQuery -> ShowS
$cshowsPrec :: Int -> ReplQuery -> ShowS
Show)

-- | A list of all ReplQuery values.
replQueries :: [ReplQuery]
replQueries :: [ReplQuery]
replQueries = [ReplQuery
QueryLoaded, ReplQuery
QueryImport, ReplQuery
QueryPrint]

replQueryStrings :: [String]
replQueryStrings :: [String]
replQueryStrings = forall a b. (a -> b) -> [a] -> [b]
map ReplQuery -> String
showReplQuery [ReplQuery]
replQueries

showReplQuery :: ReplQuery -> String
showReplQuery :: ReplQuery -> String
showReplQuery ReplQuery
QueryLoaded = String
"loaded"
showReplQuery ReplQuery
QueryImport = String
"import"
showReplQuery ReplQuery
QueryPrint = String
"print"

parseReplQuery :: String -> Maybe ReplQuery
parseReplQuery :: String -> Maybe ReplQuery
parseReplQuery String
"loaded" = forall a. a -> Maybe a
Just ReplQuery
QueryLoaded
parseReplQuery String
"import" = forall a. a -> Maybe a
Just ReplQuery
QueryImport
parseReplQuery String
"print" = forall a. a -> Maybe a
Just ReplQuery
QueryPrint
parseReplQuery String
_ = forall a. Maybe a
Nothing

data Directive
  = Help
  | Quit
  | Reload
  | Clear
  | Browse
  | Type
  | Kind
  | Show
  | Paste
  | Complete
  | Print
  deriving (Directive -> Directive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c== :: Directive -> Directive -> Bool
Eq, Int -> Directive -> ShowS
[Directive] -> ShowS
Directive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Directive] -> ShowS
$cshowList :: [Directive] -> ShowS
show :: Directive -> String
$cshow :: Directive -> String
showsPrec :: Int -> Directive -> ShowS
$cshowsPrec :: Int -> Directive -> ShowS
Show)