mirror of
https://github.com/github/semantic.git
synced 2025-01-04 13:34:31 +03:00
Move runParser into Task.
This commit is contained in:
parent
b8ebbd2a3d
commit
d87c8a98b4
@ -1,9 +1,9 @@
|
|||||||
{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
|
{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
|
||||||
module Parser
|
module Parser
|
||||||
( Parser
|
( Parser(..)
|
||||||
, runParser
|
|
||||||
-- Syntax parsers
|
-- Syntax parsers
|
||||||
, parserForLanguage
|
, parserForLanguage
|
||||||
|
, lineByLineParser
|
||||||
-- À la carte parsers
|
-- À la carte parsers
|
||||||
, jsonParser
|
, jsonParser
|
||||||
, markdownParser
|
, markdownParser
|
||||||
@ -12,7 +12,6 @@ module Parser
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified CMark
|
import qualified CMark
|
||||||
import Data.Blob
|
|
||||||
import Data.Functor.Foldable hiding (fold, Nil)
|
import Data.Functor.Foldable hiding (fold, Nil)
|
||||||
import Data.Record
|
import Data.Record
|
||||||
import Data.Source as Source
|
import Data.Source as Source
|
||||||
@ -37,7 +36,6 @@ import Text.Parser.TreeSitter.Python
|
|||||||
import Text.Parser.TreeSitter.Ruby
|
import Text.Parser.TreeSitter.Ruby
|
||||||
import Text.Parser.TreeSitter.TypeScript
|
import Text.Parser.TreeSitter.TypeScript
|
||||||
import Text.Parser.TreeSitter.JSON
|
import Text.Parser.TreeSitter.JSON
|
||||||
import TreeSitter
|
|
||||||
|
|
||||||
-- | A parser from 'Source' onto some term type.
|
-- | A parser from 'Source' onto some term type.
|
||||||
data Parser term where
|
data Parser term where
|
||||||
@ -80,22 +78,6 @@ jsonParser = AssignmentParser (ASTParser tree_sitter_json) headF JSON.assignment
|
|||||||
markdownParser :: Parser Markdown.Term
|
markdownParser :: Parser Markdown.Term
|
||||||
markdownParser = AssignmentParser MarkdownParser (\ (node@Node{..} :< _) -> node { nodeSymbol = toGrammar nodeSymbol }) Markdown.assignment
|
markdownParser = AssignmentParser MarkdownParser (\ (node@Node{..} :< _) -> node { nodeSymbol = toGrammar nodeSymbol }) Markdown.assignment
|
||||||
|
|
||||||
runParser :: Parser term -> Blob -> IO term
|
|
||||||
runParser parser blob@Blob{..} = case parser of
|
|
||||||
ASTParser language -> parseToAST language blobSource
|
|
||||||
AssignmentParser parser by assignment -> do
|
|
||||||
ast <- runParser parser blob
|
|
||||||
case assignBy by assignment blobSource ast of
|
|
||||||
Left err -> do
|
|
||||||
printError blob err
|
|
||||||
pure (errorTerm blobSource)
|
|
||||||
Right term -> pure term
|
|
||||||
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage blobSource
|
|
||||||
MarkdownParser -> pure (cmarkParser blobSource)
|
|
||||||
LineByLineParser -> pure (lineByLineParser blobSource)
|
|
||||||
|
|
||||||
errorTerm :: Syntax.Error :< fs => Source -> Term (Union fs) (Record Location)
|
|
||||||
errorTerm source = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error []))
|
|
||||||
|
|
||||||
-- | A fallback parser that treats a file simply as rows of strings.
|
-- | A fallback parser that treats a file simply as rows of strings.
|
||||||
lineByLineParser :: Source -> SyntaxTerm Text DefaultFields
|
lineByLineParser :: Source -> SyntaxTerm Text DefaultFields
|
||||||
|
@ -27,13 +27,19 @@ import Data.Blob
|
|||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import Data.Functor.Both as Both
|
import Data.Functor.Both as Both
|
||||||
import Data.Record
|
import Data.Record
|
||||||
|
import Data.Source
|
||||||
|
import qualified Data.Syntax as Syntax
|
||||||
import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
|
import Data.Syntax.Algebra (RAlgebra, decoratorWithAlgebra)
|
||||||
|
import Data.Syntax.Assignment hiding (Error)
|
||||||
|
import Data.Union
|
||||||
import Diff
|
import Diff
|
||||||
import qualified Files
|
import qualified Files
|
||||||
import Language
|
import Language
|
||||||
|
import Language.Markdown
|
||||||
import Parser
|
import Parser
|
||||||
import Prologue
|
import Prologue hiding (Location)
|
||||||
import Term
|
import Term
|
||||||
|
import TreeSitter
|
||||||
|
|
||||||
data TaskF output where
|
data TaskF output where
|
||||||
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
|
ReadBlobs :: Either Handle [(FilePath, Maybe Language)] -> TaskF [Blob]
|
||||||
@ -134,7 +140,7 @@ runTask task = do
|
|||||||
ReadBlobPairs source -> pure <$ writeLog (Info "ReadBlobPairs") <*> either Files.readBlobPairsFromHandle (traverse (traverse (uncurry Files.readFile))) source
|
ReadBlobPairs source -> pure <$ writeLog (Info "ReadBlobPairs") <*> either Files.readBlobPairsFromHandle (traverse (traverse (uncurry Files.readFile))) source
|
||||||
WriteToOutput destination contents -> pure <$ writeLog (Info "WriteToOutput") <*> liftIO (either B.hPutStr B.writeFile destination contents)
|
WriteToOutput destination contents -> pure <$ writeLog (Info "WriteToOutput") <*> liftIO (either B.hPutStr B.writeFile destination contents)
|
||||||
WriteLog message -> pure <$> liftIO (atomically (writeTMQueue logQueue message))
|
WriteLog message -> pure <$> liftIO (atomically (writeTMQueue logQueue message))
|
||||||
Parse parser blob -> pure <$ writeLog (Info "Parse") <*> liftIO (runParser parser blob)
|
Parse parser blob -> pure <$ writeLog (Info "Parse") <*> runParser parser blob
|
||||||
Decorate algebra term -> pure <$ writeLog (Info "Decorate") <*> pure (decoratorWithAlgebra algebra term)
|
Decorate algebra term -> pure <$ writeLog (Info "Decorate") <*> pure (decoratorWithAlgebra algebra term)
|
||||||
Diff differ terms -> pure <$ writeLog (Info "Diff") <*> pure (differ terms)
|
Diff differ terms -> pure <$ writeLog (Info "Diff") <*> pure (differ terms)
|
||||||
Render renderer input -> pure <$ writeLog (Info "Render") <*> pure (renderer input)
|
Render renderer input -> pure <$ writeLog (Info "Render") <*> pure (renderer input)
|
||||||
@ -152,6 +158,24 @@ runTask task = do
|
|||||||
sink queue
|
sink queue
|
||||||
_ -> pure ()
|
_ -> pure ()
|
||||||
|
|
||||||
|
runParser :: Parser term -> Blob -> Task term
|
||||||
|
runParser parser blob@Blob{..} = case parser of
|
||||||
|
ASTParser language -> liftIO $ parseToAST language blobSource
|
||||||
|
AssignmentParser parser by assignment -> do
|
||||||
|
ast <- runParser parser blob
|
||||||
|
case assignBy by assignment blobSource ast of
|
||||||
|
Left err -> do
|
||||||
|
options <- liftIO $ optionsForHandle stderr
|
||||||
|
writeLog (Warning (formatErrorWithOptions options blob err))
|
||||||
|
pure (errorTerm blobSource)
|
||||||
|
Right term -> pure term
|
||||||
|
TreeSitterParser language tslanguage -> liftIO $ treeSitterParser language tslanguage blobSource
|
||||||
|
MarkdownParser -> pure (cmarkParser blobSource)
|
||||||
|
LineByLineParser -> pure (lineByLineParser blobSource)
|
||||||
|
|
||||||
|
errorTerm :: Syntax.Error :< fs => Source -> Term (Union fs) (Record Location)
|
||||||
|
errorTerm source = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error []))
|
||||||
|
|
||||||
|
|
||||||
instance MonadIO Task where
|
instance MonadIO Task where
|
||||||
liftIO action = LiftIO action `Then` return
|
liftIO action = LiftIO action `Then` return
|
||||||
|
Loading…
Reference in New Issue
Block a user