git.iko.soy/rowtype-yoga/purescript-native
on 24fdff2 help sign in
rowtype-yoga/purescript-native/psci/Parser.hs
138 lines 4.1 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Parser
4-- Copyright : (c) Phil Freeman 2014
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12-- Parser for PSCI.
13--
14-----------------------------------------------------------------------------
16module Parser
17 ( parseCommand
18 ) where
20import Prelude ()
21import Prelude.Compat hiding (lex)
23import Data.Char (isSpace)
24import Data.List (intercalate)
26import Text.Parsec hiding ((<|>))
28import qualified Language.PureScript as P
29import Language.PureScript.Parser.Common (mark, same)
31import qualified Directive as D
32import Types
34-- |
35-- Parses PSCI metacommands or expressions input from the user.
36--
37parseCommand :: String -> Either String Command
38parseCommand cmdString =
39 case cmdString of
40 (':' : cmd) -> parseDirective cmd
41 _ -> parseRest psciCommand cmdString
43parseRest :: P.TokenParser a -> String -> Either String a
44parseRest p s = either (Left . show) Right $ do
45 ts <- P.lex "" s
46 P.runTokenParser "" (p <* eof) ts
48psciCommand :: P.TokenParser Command
49psciCommand = choice (map try parsers)
50 where
51 parsers =
52 [ psciLet
53 , psciImport
54 , psciOtherDeclaration
55 , psciExpression
56 ]
58trim :: String -> String
59trim = trimEnd . trimStart
61trimStart :: String -> String
62trimStart = dropWhile isSpace
64trimEnd :: String -> String
65trimEnd = reverse . trimStart . reverse
67parseDirective :: String -> Either String Command
68parseDirective cmd =
69 case D.directivesFor' dstr of
70 [(d, _)] -> commandFor d
71 [] -> Left "Unrecognized directive. Type :? for help."
72 ds -> Left ("Ambiguous directive. Possible matches: " ++
73 intercalate ", " (map snd ds) ++ ". Type :? for help.")
74 where
75 (dstr, arg) = break isSpace cmd
77 commandFor d = case d of
78 Help -> return ShowHelp
79 Quit -> return QuitPSCi
80 Reset -> return ResetState
81 Browse -> BrowseModule <$> parseRest P.moduleName arg
82 Load -> return $ LoadFile (trim arg)
83 Foreign -> return $ LoadForeign (trim arg)
84 Show -> ShowInfo <$> parseReplQuery' (trim arg)
85 Type -> TypeOf <$> parseRest P.parseValue arg
86 Kind -> KindOf <$> parseRest P.parseType arg
88-- |
89-- Parses expressions entered at the PSCI repl.
90--
91psciExpression :: P.TokenParser Command
92psciExpression = Expression <$> P.parseValue
94-- |
95-- PSCI version of @let@.
96-- This is essentially let from do-notation.
97-- However, since we don't support the @Eff@ monad,
98-- we actually want the normal @let@.
99--
100psciLet :: P.TokenParser Command
101psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
102 where
103 manyDecls :: P.TokenParser [P.Declaration]
104 manyDecls = mark (many1 (same *> P.parseLocalDeclaration))
106-- | Imports must be handled separately from other declarations, so that
107-- :show import works, for example.
108psciImport :: P.TokenParser Command
109psciImport = Import <$> P.parseImportDeclaration'
111-- | Any other declaration that we don't need a 'special case' parser for
112-- (like let or import declarations).
113psciOtherDeclaration :: P.TokenParser Command
114psciOtherDeclaration = Decls . (:[]) <$> do
115 decl <- discardPositionInfo <$> P.parseDeclaration
116 if acceptable decl
117 then return decl
118 else fail "this kind of declaration is not supported in psci"
120discardPositionInfo :: P.Declaration -> P.Declaration
121discardPositionInfo (P.PositionedDeclaration _ _ d) = d
122discardPositionInfo d = d
124acceptable :: P.Declaration -> Bool
125acceptable P.DataDeclaration{} = True
126acceptable P.TypeSynonymDeclaration{} = True
127acceptable P.ExternDeclaration{} = True
128acceptable P.ExternDataDeclaration{} = True
129acceptable P.TypeClassDeclaration{} = True
130acceptable P.TypeInstanceDeclaration{} = True
131acceptable _ = False
133parseReplQuery' :: String -> Either String ReplQuery
134parseReplQuery' str =
135 case parseReplQuery str of
136 Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
137 intercalate ", " replQueryStrings ++ ".")
138 Just query -> Right query