module Language.PureScript.Interactive.Parser
( parseDotFile
, parseCommand
) where
import Prelude
import Control.Monad (join)
import Data.Bifunctor (bimap)
import Data.Char (isSpace)
import Data.List (intercalate)
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Language.PureScript as P
import qualified Language.PureScript.CST as CST
import qualified Language.PureScript.CST.Monad as CSTM
import qualified Language.PureScript.Interactive.Directive as D
import Language.PureScript.Interactive.Types
parseDotFile :: FilePath -> String -> Either String [Command]
parseDotFile :: [Char] -> [Char] -> Either [Char] [Command]
parseDotFile [Char]
filePath =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ParserError -> [Char]
CST.prettyPrintError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head) forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Parser a
-> [LexResult]
-> Either (NonEmpty ParserError) ([ParserWarning], a)
CST.runTokenParser (forall a. Parser a -> Parser [a]
parseMany Parser Command
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> Parser SourceToken
CSTM.token Token
CST.TokEof)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [LexResult]
CST.lexTopLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
where
parser :: Parser Command
parser = forall a. NonEmpty (Parser a) -> Parser a
CSTM.oneOf forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList
[ [Char] -> Parser Command
psciImport [Char]
filePath
, do
SourceToken
tok <- Parser SourceToken
CSTM.munch
forall a. SourceToken -> ParserErrorType -> Parser a
CSTM.parseFail SourceToken
tok forall a b. (a -> b) -> a -> b
$ [Char] -> ParserErrorType
CST.ErrCustom [Char]
"The .purs-repl file only supports import declarations"
]
parseCommand :: String -> Either String [Command]
parseCommand :: [Char] -> Either [Char] [Command]
parseCommand [Char]
cmdString =
case [Char]
cmdString of
(Char
':' : [Char]
cmd) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either [Char] Command
parseDirective [Char]
cmd
[Char]
_ -> forall a. Parser a -> [Char] -> Either [Char] a
parseRest ([Command] -> [Command]
mergeDecls forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser [a]
parseMany Parser Command
psciCommand) [Char]
cmdString
where
mergeDecls :: [Command] -> [Command]
mergeDecls (Decls [Declaration]
as : [Command]
bs) =
case [Command] -> [Command]
mergeDecls [Command]
bs of
Decls [Declaration]
bs' : [Command]
cs' ->
[Declaration] -> Command
Decls ([Declaration]
as forall a. Semigroup a => a -> a -> a
<> [Declaration]
bs') forall a. a -> [a] -> [a]
: [Command]
cs'
[Command]
cs' ->
[Declaration] -> Command
Decls [Declaration]
as forall a. a -> [a] -> [a]
: [Command]
cs'
mergeDecls (Command
a : [Command]
bs) =
Command
a forall a. a -> [a] -> [a]
: [Command] -> [Command]
mergeDecls [Command]
bs
mergeDecls [] = []
parseMany :: CST.Parser a -> CST.Parser [a]
parseMany :: forall a. Parser a -> Parser [a]
parseMany = forall a. Token -> Token -> Token -> Parser a -> Parser [a]
CSTM.manyDelimited Token
CST.TokLayoutStart Token
CST.TokLayoutEnd Token
CST.TokLayoutSep
parseOne :: CST.Parser a -> CST.Parser a
parseOne :: forall a. Parser a -> Parser a
parseOne Parser a
p = Token -> Parser SourceToken
CSTM.token Token
CST.TokLayoutStart forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> Parser SourceToken
CSTM.token Token
CST.TokLayoutEnd
parseRest :: CST.Parser a -> String -> Either String a
parseRest :: forall a. Parser a -> [Char] -> Either [Char] a
parseRest Parser a
p =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ParserError -> [Char]
CST.prettyPrintError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head) forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Parser a
-> [LexResult]
-> Either (NonEmpty ParserError) ([ParserWarning], a)
CST.runTokenParser (Parser a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token -> Parser SourceToken
CSTM.token Token
CST.TokEof)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [LexResult]
CST.lexTopLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
psciCommand :: CST.Parser Command
psciCommand :: Parser Command
psciCommand =
forall a. NonEmpty (Parser a) -> Parser a
CSTM.oneOf forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList
[ [Char] -> Parser Command
psciImport [Char]
""
, Parser Command
psciDeclaration
, Parser Command
psciExpression
]
trim :: String -> String
trim :: [Char] -> [Char]
trim = [Char] -> [Char]
trimEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
trimStart
trimStart :: String -> String
trimStart :: [Char] -> [Char]
trimStart = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
trimEnd :: String -> String
trimEnd :: [Char] -> [Char]
trimEnd = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
trimStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
parseDirective :: String -> Either String Command
parseDirective :: [Char] -> Either [Char] Command
parseDirective [Char]
cmd =
case [Char] -> [(Directive, [Char])]
D.directivesFor' [Char]
dstr of
[(Directive
d, [Char]
_)] -> Directive -> Either [Char] Command
commandFor Directive
d
[] -> forall a b. a -> Either a b
Left [Char]
"Unrecognized directive. Type :? for help."
[(Directive, [Char])]
ds -> forall a b. a -> Either a b
Left ([Char]
"Ambiguous directive. Possible matches: " forall a. [a] -> [a] -> [a]
++
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Directive, [Char])]
ds) forall a. [a] -> [a] -> [a]
++ [Char]
". Type :? for help.")
where
([Char]
dstr, [Char]
arg) = [Char] -> [Char]
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSpace [Char]
cmd
commandFor :: Directive -> Either [Char] Command
commandFor Directive
d = case Directive
d of
Directive
Help -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
ShowHelp
Directive
Quit -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
QuitPSCi
Directive
Reload -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
ReloadState
Directive
Clear -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
ClearState
Directive
Paste -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
PasteLines
Directive
Browse -> ModuleName -> Command
BrowseModule forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> a
CST.nameValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> [Char] -> Either [Char] a
parseRest (forall a. Parser a -> Parser a
parseOne Parser (Name ModuleName)
CST.parseModuleNameP) [Char]
arg
Directive
Show -> ReplQuery -> Command
ShowInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either [Char] ReplQuery
parseReplQuery' [Char]
arg
Directive
Type -> Expr -> Command
TypeOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Expr a -> Expr
CST.convertExpr [Char]
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> [Char] -> Either [Char] a
parseRest (forall a. Parser a -> Parser a
parseOne Parser (Expr ())
CST.parseExprP) [Char]
arg
Directive
Kind -> SourceType -> Command
KindOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Type a -> SourceType
CST.convertType [Char]
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> [Char] -> Either [Char] a
parseRest (forall a. Parser a -> Parser a
parseOne Parser (Type ())
CST.parseTypeP) [Char]
arg
Directive
Complete -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Command
CompleteStr [Char]
arg)
Directive
Print
| [Char]
arg forall a. Eq a => a -> a -> Bool
== [Char]
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ReplQuery -> Command
ShowInfo ReplQuery
QueryPrint
| Bool
otherwise -> (ModuleName, Ident) -> Command
SetInteractivePrint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> [Char] -> Either [Char] a
parseRest (forall a. Parser a -> Parser a
parseOne Parser (ModuleName, Ident)
parseFullyQualifiedIdent) [Char]
arg
psciExpression :: CST.Parser Command
psciExpression :: Parser Command
psciExpression = Expr -> Command
Expression forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Expr a -> Expr
CST.convertExpr [Char]
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Expr ())
CST.parseExprP
psciImport :: FilePath -> CST.Parser Command
psciImport :: [Char] -> Parser Command
psciImport [Char]
filePath = do
(SourceAnn
_, ModuleName
mn, ImportDeclarationType
declType, Maybe ModuleName
asQ) <- forall a.
[Char]
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
CST.convertImportDecl [Char]
filePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (ImportDecl ())
CST.parseImportDeclP
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ImportedModule -> Command
Import (ModuleName
mn, ImportDeclarationType
declType, Maybe ModuleName
asQ)
psciDeclaration :: CST.Parser Command
psciDeclaration :: Parser Command
psciDeclaration = [Declaration] -> Command
Decls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Char] -> Declaration a -> [Declaration]
CST.convertDeclaration [Char]
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Declaration ())
CST.parseDeclP
parseReplQuery' :: String -> Either String ReplQuery
parseReplQuery' :: [Char] -> Either [Char] ReplQuery
parseReplQuery' [Char]
str =
case [Char] -> Maybe ReplQuery
parseReplQuery [Char]
str of
Maybe ReplQuery
Nothing -> forall a b. a -> Either a b
Left ([Char]
"Don't know how to show " forall a. [a] -> [a] -> [a]
++ [Char]
str forall a. [a] -> [a] -> [a]
++ [Char]
". Try one of: " forall a. [a] -> [a] -> [a]
++
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
replQueryStrings forall a. [a] -> [a] -> [a]
++ [Char]
".")
Just ReplQuery
query -> forall a b. b -> Either a b
Right ReplQuery
query
parseFullyQualifiedIdent :: CST.Parser (P.ModuleName, P.Ident)
parseFullyQualifiedIdent :: Parser (ModuleName, Ident)
parseFullyQualifiedIdent = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall e s a.
(forall r. s -> (s -> e -> r) -> (s -> a -> r) -> r)
-> ParserM e s a
CST.Parser forall a b. (a -> b) -> a -> b
$ \ParserState
st ParserState -> ParserError -> r
_ ParserState -> Parser (ModuleName, Ident) -> r
ksucc ->
case forall a.
ParserState
-> Parser a -> (ParserState, Either (NonEmpty ParserError) a)
CST.runParser ParserState
st Parser (QualifiedName Ident)
CST.parseQualIdentP of
(ParserState
st', Right (CST.QualifiedName SourceToken
_ (Just ModuleName
mn) Ident
ident)) ->
ParserState -> Parser (ModuleName, Ident) -> r
ksucc ParserState
st' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModuleName
mn, Text -> Ident
P.Ident forall a b. (a -> b) -> a -> b
$ Ident -> Text
CST.getIdent Ident
ident)
(ParserState, Either (NonEmpty ParserError) (QualifiedName Ident))
_ ->
ParserState -> Parser (ModuleName, Ident) -> r
ksucc ParserState
st forall a b. (a -> b) -> a -> b
$ do
SourceToken
tok <- Parser SourceToken
CSTM.munch
forall a. SourceToken -> ParserErrorType -> Parser a
CSTM.parseFail SourceToken
tok forall a b. (a -> b) -> a -> b
$ [Char] -> ParserErrorType
CST.ErrCustom [Char]
"Expected a fully-qualified name (eg: PSCI.Support.eval)"