0 | module Parser.Source
 1 |
 2 | import public Parser.Lexer.Source
 3 | import public Parser.Rule.Source
 4 | import public Parser.Unlit
 5 |
 6 | import Core.Core
 7 | import Core.Name
 8 | import Core.Metadata
 9 | import Core.FC
10 |
11 | import System.File
12 |
13 | %default total
14 |
15 | export
16 | runParserTo : {e : _} ->
17 |               (origin : OriginDesc) ->
18 |               Maybe LiterateStyle -> Lexer ->
19 |               String -> Grammar ParsingState Token e ty ->
20 |               Either Error (List Warning, State, ty)
21 | runParserTo origin lit reject str p
22 |     = do str        <- mapFst (fromLitError origin) $ unlit lit str
23 |          (cs, toks) <- mapFst (fromLexError origin) $ lexTo reject str
24 |          (decs, ws, (parsed, _)) <- mapFst (fromParsingErrors origin) $ parseWith p toks
25 |          let cs : SemanticDecorations
26 |                 = cs <&> \ c => ((origin, start c, end c), Comment, Nothing)
27 |          let ws = ws <&> \ (mb, warn) =>
28 |                     let mkFC = \ b => MkFC origin (startBounds b) (endBounds b)
29 |                     in ParserWarning (maybe EmptyFC mkFC mb) warn
30 |          let state : State
31 |              state = { decorations $= (cs++) } (toState decs)
32 |          pure (ws, state, parsed)
33 |
34 | export
35 | runParser : {e : _} ->
36 |             (origin : OriginDesc) -> Maybe LiterateStyle -> String ->
37 |             Grammar ParsingState Token e ty ->
38 |             Either Error (List Warning, State, ty)
39 | runParser origin lit = runParserTo origin lit (pred $ const False)
40 |
41 | export covering
42 | parseFile : (fname : String)
43 |          -> (origin : OriginDesc)
44 |          -> Rule ty
45 |          -> IO (Either Error (List Warning, State, ty))
46 | parseFile fname origin p
47 |     = do Right str <- readFile fname
48 |              | Left err => pure (Left (FileErr fname err))
49 |          pure (runParser origin (isLitFile fname) str p)
50 |