Skip to content

Commit 67323ef

Browse files
natefaubionnatefaubion
authored
Add shebang support (#55)
Fixes #54
1 parent bf5623e commit 67323ef

File tree

4 files changed

+124
-15
lines changed

4 files changed

+124
-15
lines changed

‎package.json‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@
99
},
1010
"devDependencies": {
1111
"purescript": "^0.15.0",
12-
"purs-tidy": "^0.8.0",
13-
"spago": "^0.20.9"
12+
"purs-tidy": "^0.10.0",
13+
"spago": "^0.21.0"
1414
}
1515
}

‎src/PureScript/CST.purs‎

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -23,13 +23,14 @@ import Data.Lazy as Z
2323
import Data.Maybe (Maybe(..))
2424
import Data.Newtype (unwrap)
2525
import Data.Tuple (Tuple(..))
26-
import PureScript.CST.Lexer (lex)
26+
import PureScript.CST.Lexer (lex, lexModule)
2727
import PureScript.CST.Parser (Recovered, parseModuleBody, parseModuleHeader)
2828
import PureScript.CST.Parser as Parser
2929
import PureScript.CST.Parser.Monad (Parser, ParserResult(..), PositionedError, fromParserResult, initialParserState, runParser, runParser')
3030
import PureScript.CST.Print as Print
3131
import PureScript.CST.Range (class TokensOf, tokensOf)
3232
import PureScript.CST.Range.TokenList as TokenList
33+
import PureScript.CST.TokenStream (TokenStream)
3334
import PureScript.CST.Types (Binder, Declaration, Expr, ImportDecl, Module(..), ModuleHeader, Type)
3435
import Unsafe.Coerce (unsafeCoerce)
3536

@@ -54,26 +55,26 @@ toRecoveredParserResult = case _ of
5455
toRecovered :: forall f. f Void -> Recovered f
5556
toRecovered = unsafeCoerce
5657

57-
runRecoveredParser :: forall a. Parser (Recovered a) -> String -> RecoveredParserResult a
58-
runRecoveredParser p = toRecoveredParserResult <<< flip runParser p <<< lex
58+
runRecoveredParser :: forall a. Parser (Recovered a) -> TokenStream -> RecoveredParserResult a
59+
runRecoveredParser p = toRecoveredParserResult <<< flip runParser p
5960

6061
parseModule :: String -> RecoveredParserResult Module
61-
parseModule = runRecoveredParser Parser.parseModule
62+
parseModule = runRecoveredParser Parser.parseModule <<< lexModule
6263

6364
parseImportDecl :: String -> RecoveredParserResult ImportDecl
64-
parseImportDecl = runRecoveredParser Parser.parseImportDecl
65+
parseImportDecl = runRecoveredParser Parser.parseImportDecl <<< lex
6566

6667
parseDecl :: String -> RecoveredParserResult Declaration
67-
parseDecl = runRecoveredParser Parser.parseDecl
68+
parseDecl = runRecoveredParser Parser.parseDecl <<< lex
6869

6970
parseExpr :: String -> RecoveredParserResult Expr
70-
parseExpr = runRecoveredParser Parser.parseExpr
71+
parseExpr = runRecoveredParser Parser.parseExpr <<< lex
7172

7273
parseType :: String -> RecoveredParserResult Type
73-
parseType = runRecoveredParser Parser.parseType
74+
parseType = runRecoveredParser Parser.parseType <<< lex
7475

7576
parseBinder :: String -> RecoveredParserResult Binder
76-
parseBinder = runRecoveredParser Parser.parseBinder
77+
parseBinder = runRecoveredParser Parser.parseBinder <<< lex
7778

7879
newtype PartialModule e = PartialModule
7980
{ header :: ModuleHeader e
@@ -82,7 +83,7 @@ newtype PartialModule e = PartialModule
8283

8384
parsePartialModule :: String -> RecoveredParserResult PartialModule
8485
parsePartialModule src =
85-
toRecoveredParserResult $ case runParser' (initialParserState (lex src)) parseModuleHeader of
86+
toRecoveredParserResult $ case runParser' (initialParserState (lexModule src)) parseModuleHeader of
8687
ParseSucc header state -> do
8788
let
8889
res = PartialModule

‎src/PureScript/CST/Lexer.purs‎

Lines changed: 31 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module PureScript.CST.Lexer
22
( lex
3+
, lexModule
34
, lexWithState
45
, lexToken
56
) where
@@ -9,6 +10,7 @@ import Prelude
910
import Control.Alt (class Alt, alt)
1011
import Control.Monad.ST as ST
1112
import Control.Monad.ST.Ref as STRef
13+
import Data.Array as Array
1214
import Data.Array.NonEmpty as NonEmptyArray
1315
import Data.Array.ST as STArray
1416
import Data.Char as Char
@@ -193,15 +195,23 @@ many (Lex k) = Lex \str -> ST.run do
193195
fail :: forall a. ParseError -> Lex LexError a
194196
fail = Lex <<< LexFail <<< const
195197

198+
-- | Lexes according to root layout rules and standard language comments.
196199
lex :: String -> TokenStream
197200
lex = lexWithState (Tuple { line: 0, column: 0 } LytRoot : Nil) { line: 0, column: 0 }
198201

202+
-- | Lexes according to root layout rules as well as supporting leading shebang comments.
203+
lexModule :: String -> TokenStream
204+
lexModule = lexWithState' leadingModuleComments (Tuple { line: 0, column: 0 } LytRoot : Nil) { line: 0, column: 0 }
205+
199206
lexWithState :: LayoutStack -> SourcePos -> String -> TokenStream
200-
lexWithState = init
207+
lexWithState = lexWithState' leadingComments
208+
209+
lexWithState' :: Lex LexError (Array (Comment LineFeed)) -> LayoutStack -> SourcePos -> String -> TokenStream
210+
lexWithState' lexLeadingComments = init
201211
where
202212
init :: LayoutStack -> SourcePos -> String -> TokenStream
203213
init initStack initPos str = TokenStream $ Lazy.defer \_ -> do
204-
let (Lex k) = leadingComments
214+
let (Lex k) = lexLeadingComments
205215
case k str of
206216
LexFail _ _ ->
207217
unsafeCrashWith "Leading comments can't fail."
@@ -358,6 +368,15 @@ bumpComment pos@{ line, column } = case _ of
358368
qualLength :: Maybe ModuleName -> Int
359369
qualLength = maybe 0 (add 1 <<< String.length <<< unwrap)
360370

371+
leadingModuleComments :: Lex LexError (Array (Comment LineFeed))
372+
leadingModuleComments = append <$> (leadingShebangs <|> pure []) <*> leadingComments
373+
374+
leadingShebangs :: Lex LexError (Array (Comment LineFeed))
375+
leadingShebangs = ado
376+
head <- shebangComment
377+
tail <- many (try (Tuple <$> oneLineComment <*> shebangComment))
378+
in Array.cons (Comment head) (foldMap (\(Tuple a b) -> [ a, Comment b ]) tail)
379+
361380
leadingComments :: Lex LexError (Array (Comment LineFeed))
362381
leadingComments = many do
363382
Comment <$> comment
@@ -374,6 +393,9 @@ comment =
374393
regex (LexExpected "block comment") """\{-(-(?!\})|[^-]+)*(-\}|$)"""
375394
<|> regex (LexExpected "line comment") """--[^\r\n]*"""
376395

396+
shebangComment :: Lex LexError String
397+
shebangComment = regex (LexExpected "shebang") """#![^\r\n]*"""
398+
377399
spaceComment :: Lex LexError Int
378400
spaceComment = SCU.length <$> regex (LexExpected "spaces") " +"
379401

@@ -382,6 +404,13 @@ lineComment =
382404
(Line LF <<< String.length) <$> regex (LexExpected "newline") "\n+"
383405
<|> (Line CRLF <<< (_ / 2) <<< String.length) <$> regex (LexExpected "newline") "(?:\r\n)+"
384406

407+
oneLineComment :: Lex LexError (Comment LineFeed)
408+
oneLineComment = do
409+
line <- lineComment
410+
case line of
411+
Line _ 1 -> pure line
412+
_ -> fail $ LexExpected "one newline" "multiple newlines"
413+
385414
token :: Lex LexError Token
386415
token =
387416
parseHole

‎test/Main.purs‎

Lines changed: 80 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import Effect (Effect)
1313
import Effect.Class.Console as Console
1414
import Node.Process as Process
1515
import PureScript.CST (RecoveredParserResult(..), parseBinder, parseDecl, parseExpr, parseModule, parseType)
16-
import PureScript.CST.Types (AppSpine(..), Binder, Declaration(..), DoStatement(..), Expr(..), Label(..), Labeled(..), LetBinding(..), Module(..), ModuleBody(..), Name(..), Prefixed(..), RecordLabeled(..), Separated(..), Token(..), Type(..), TypeVarBinding(..), Wrapped(..))
16+
import PureScript.CST.Types (AppSpine(..), Binder, Comment(..), Declaration(..), DoStatement(..), Expr(..), Label(..), Labeled(..), LetBinding(..), LineFeed(..), Module(..), ModuleBody(..), ModuleHeader(..), Name(..), Prefixed(..), RecordLabeled(..), Separated(..), Token(..), Type(..), TypeVarBinding(..), Wrapped(..))
1717

1818
class ParseFor f where
1919
parseFor :: String -> RecoveredParserResult f
@@ -291,3 +291,82 @@ main = do
291291
true
292292
_ ->
293293
false
294+
295+
assertParse "No module shebang"
296+
"""
297+
-- no shebang
298+
module Test where
299+
"""
300+
case _ of
301+
ParseSucceeded (Module { header: ModuleHeader { keyword } })
302+
| [ Comment "-- no shebang"
303+
, Line LF 1
304+
] <- keyword.leadingComments ->
305+
true
306+
_ ->
307+
false
308+
309+
assertParse "Module shebang"
310+
"""
311+
#! shebang
312+
module Test where
313+
"""
314+
case _ of
315+
ParseSucceeded (Module { header: ModuleHeader { keyword } })
316+
| [ Comment "#! shebang"
317+
, Line LF 1
318+
] <- keyword.leadingComments ->
319+
true
320+
_ ->
321+
false
322+
323+
assertParse "Multiple module shebangs"
324+
"""
325+
#! shebang 1
326+
#! shebang 2
327+
#! shebang 3
328+
-- no shebang
329+
module Test where
330+
"""
331+
case _ of
332+
ParseSucceeded (Module { header: ModuleHeader { keyword } })
333+
| [ Comment "#! shebang 1"
334+
, Line LF 1
335+
, Comment "#! shebang 2"
336+
, Line LF 1
337+
, Comment "#! shebang 3"
338+
, Line LF 1
339+
, Comment "-- no shebang"
340+
, Line LF 1
341+
] <- keyword.leadingComments ->
342+
true
343+
_ ->
344+
false
345+
346+
assertParse "Multiple lines between shebangs should fail"
347+
"""
348+
#! shebang 1
349+
350+
#! shebang 2
351+
#! shebang 3
352+
module Test where
353+
"""
354+
case _ of
355+
(ParseFailed _ :: RecoveredParserResult Module) ->
356+
true
357+
_ ->
358+
false
359+
360+
assertParse "Comments between shebangs should fail"
361+
"""
362+
#! shebang 1
363+
-- no shebang
364+
#! shebang 2
365+
#! shebang 3
366+
module Test where
367+
"""
368+
case _ of
369+
(ParseFailed _ :: RecoveredParserResult Module) ->
370+
true
371+
_ ->
372+
false

0 commit comments

Comments
 (0)