mirror of
https://github.com/github/semantic.git
synced 2024-12-28 09:21:35 +03:00
Merge branch 'semantic-java' into precise-s-expressions
This commit is contained in:
Rob Rix
commit
57826de7a0
@ -30,7 +30,7 @@ before_install:
|
||||
|
||||
install:
|
||||
- cabal new-update -v
|
||||
- cabal new-configure --enable-tests --disable-optimization --write-ghc-environment-files=always --jobs=2
|
||||
- cabal new-configure --enable-tests --enable-benchmarks --disable-optimization --write-ghc-environment-files=always --jobs=2
|
||||
- cabal new-build --only-dependencies
|
||||
|
||||
script:
|
||||
|
||||
@ -86,7 +86,7 @@ Available options:
|
||||
| | Java | ✅ | ✅ | ✅ | 🔶 | ✅ | | | |
|
||||
| | JSON | ✅ | ✅ | ✅ | N/A | N/A | N/A | N/A| |
|
||||
| | JSX | ✅ | ✅ | ✅ | 🔶 | | | | |
|
||||
| | Haskell | ✅ | ✅ | ✅ | 🔶 | ✅ | | | |
|
||||
| | Haskell | 🚧 | 🚧 | 🚧 | 🔶 | 🚧 | | | |
|
||||
| | Markdown | ✅ | ✅ | ✅ | 🔶 | N/A | N/A | N/A | |
|
||||
|
||||
* ✅ — Supported
|
||||
|
||||
@ -1,9 +1,11 @@
|
||||
{-# LANGUAGE DataKinds, FlexibleContexts, PackageImports, PartialTypeSignatures, TypeApplications, TypeFamilies #-}
|
||||
|
||||
module Main where
|
||||
module Evaluation (benchmarks) where
|
||||
|
||||
import Algebra.Graph
|
||||
import Control.Monad
|
||||
import Control.Carrier.Parse.Simple
|
||||
import qualified Data.Duration as Duration
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.FreeVariables
|
||||
import Data.Blob
|
||||
@ -45,7 +47,7 @@ callGraphProject' :: ( Language.SLanguage lang
|
||||
-> IO (Either String (Data.Graph.Graph ControlFlowVertex))
|
||||
callGraphProject' session proxy parser path = fmap (first show) . runTask session $ do
|
||||
blob <- readBlobFromFile' (fileForRelPath path)
|
||||
package <- fmap snd <$> parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] (Language.reflect proxy) [])
|
||||
package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] (Language.reflect proxy) []))
|
||||
modules <- topologicalSort <$> runImportGraphToModules proxy package
|
||||
runCallGraph proxy False modules package
|
||||
|
||||
@ -70,8 +72,8 @@ pyCall p = nfIO $ callGraphProject (Proxy @'Language.Python) pythonParser (Path.
|
||||
rbCall :: Path.RelFile -> Benchmarkable
|
||||
rbCall p = nfIO $ callGraphProject (Proxy @'Language.Ruby) rubyParser $ (Path.relDir "bench/bench-fixtures/ruby" </> p)
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
benchmarks :: Benchmark
|
||||
benchmarks = bgroup "evaluation"
|
||||
[ bgroup "python" [ bench "assignment" . pyEval $ Path.relFile "simple-assignment.py"
|
||||
, bench "function def" . pyEval $ Path.relFile "function-definition.py"
|
||||
, bench "if + function calls" . pyCall . Path.relFile $ "if-statement-functions.py"
|
||||
9
bench/Main.hs
Normal file
9
bench/Main.hs
Normal file
@ -0,0 +1,9 @@
|
||||
module Main where
|
||||
|
||||
import Gauge
|
||||
import qualified Evaluation
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
[ Evaluation.benchmarks
|
||||
]
|
||||
@ -1,3 +1,7 @@
|
||||
# 0.0.1.0
|
||||
|
||||
- Adds an `NFData` instance for `Source`.
|
||||
|
||||
# 0.0.0.1
|
||||
|
||||
- Loosens the upper bound on `hashable`.
|
||||
|
||||
@ -32,6 +32,7 @@ module Source.Source
|
||||
import Prelude hiding (drop, take)
|
||||
|
||||
import Control.Arrow ((&&&))
|
||||
import Control.DeepSeq (NFData)
|
||||
import Data.Aeson (FromJSON (..), withText)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Char (ord)
|
||||
@ -50,7 +51,7 @@ import Source.Span (Span(Span), Pos(..))
|
||||
-- 'ByteString' under the hood. Construct these with 'fromUTF8'; obviously,
|
||||
-- passing 'fromUTF8' non-UTF8 bytes will cause crashes.
|
||||
newtype Source = Source { bytes :: B.ByteString }
|
||||
deriving (Eq, Semigroup, Monoid, IsString, Show, Generic)
|
||||
deriving (Eq, Semigroup, Monoid, IsString, Show, Generic, NFData)
|
||||
|
||||
fromUTF8 :: B.ByteString -> Source
|
||||
fromUTF8 = Source
|
||||
|
||||
@ -68,6 +68,7 @@ common dependencies
|
||||
, semilattices ^>= 0.0.0.3
|
||||
, shelly >= 1.5 && <2
|
||||
, streaming ^>= 0.2.2.0
|
||||
, streaming-bytestring ^>= 0.1.6
|
||||
, text ^>= 1.2.3.1
|
||||
, these >= 0.7 && <1
|
||||
, unix ^>= 2.7.2.2
|
||||
@ -194,14 +195,6 @@ library
|
||||
, Language.Go.Assignment
|
||||
, Language.Go.Syntax
|
||||
, Language.Go.Type
|
||||
, Language.Haskell.Assignment
|
||||
, Language.Haskell.Syntax
|
||||
, Language.Haskell.Syntax.Constructor
|
||||
, Language.Haskell.Syntax.Haskell
|
||||
, Language.Haskell.Syntax.Identifier
|
||||
, Language.Haskell.Syntax.Pattern
|
||||
, Language.Haskell.Syntax.QuasiQuote
|
||||
, Language.Haskell.Syntax.Type
|
||||
, Language.JSON.Assignment
|
||||
, Language.JSON.PrettyPrint
|
||||
, Language.Ruby.Assignment
|
||||
@ -312,6 +305,7 @@ library
|
||||
, semantic-tags ^>= 0
|
||||
, semigroupoids ^>= 5.3.2
|
||||
, split ^>= 0.2.3.3
|
||||
, streaming-process ^>= 0.1
|
||||
, stm-chans ^>= 3.0.0.4
|
||||
, template-haskell ^>= 2.14
|
||||
, time ^>= 1.8.0.2
|
||||
@ -319,7 +313,6 @@ library
|
||||
, unordered-containers ^>= 0.2.9.0
|
||||
, vector ^>= 0.12.0.2
|
||||
, tree-sitter-go ^>= 0.2
|
||||
, tree-sitter-haskell ^>= 0.2
|
||||
, tree-sitter-json ^>= 0.2
|
||||
, tree-sitter-php ^>= 0.2
|
||||
, tree-sitter-python ^>= 0.5
|
||||
@ -411,15 +404,16 @@ test-suite parse-examples
|
||||
, foldl ^>= 1.4.5
|
||||
, resourcet ^>= 1.2
|
||||
, streaming
|
||||
, streaming-bytestring ^>= 0.1.6
|
||||
, streaming-bytestring
|
||||
, tasty
|
||||
, tasty-hunit
|
||||
|
||||
benchmark evaluation
|
||||
import: haskell, dependencies, executable-flags
|
||||
hs-source-dirs: bench/evaluation
|
||||
hs-source-dirs: bench
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Main.hs
|
||||
other-modules: Evaluation
|
||||
ghc-options: -static
|
||||
build-depends: base
|
||||
, algebraic-graphs
|
||||
|
||||
@ -16,7 +16,6 @@ import qualified Data.Syntax.Statement as Statement
|
||||
import qualified Data.Syntax.Type as Type
|
||||
import qualified Language.Go.Syntax as Go
|
||||
import qualified Language.Go.Type as Go
|
||||
import qualified Language.Haskell.Syntax as Haskell
|
||||
import qualified Language.Markdown.Syntax as Markdown
|
||||
import qualified Language.PHP.Syntax as PHP
|
||||
import qualified Language.Python.Syntax as Python
|
||||
@ -179,128 +178,6 @@ instance AccessControls1 Declaration.VariableDeclaration
|
||||
instance AccessControls1 Directive.File
|
||||
instance AccessControls1 Directive.Line
|
||||
|
||||
instance AccessControls1 Haskell.UnitConstructor
|
||||
instance AccessControls1 Haskell.ListConstructor
|
||||
instance AccessControls1 Haskell.FunctionConstructor
|
||||
instance AccessControls1 Haskell.RecordDataConstructor
|
||||
instance AccessControls1 Haskell.AllConstructors
|
||||
instance AccessControls1 Haskell.GADTConstructor
|
||||
instance AccessControls1 Haskell.LabeledConstruction
|
||||
instance AccessControls1 Haskell.InfixDataConstructor
|
||||
instance AccessControls1 Haskell.TupleConstructor
|
||||
instance AccessControls1 Haskell.TypeConstructorExport
|
||||
instance AccessControls1 Haskell.KindParenthesizedConstructor
|
||||
instance AccessControls1 Haskell.ConstructorSymbol
|
||||
instance AccessControls1 Haskell.Module
|
||||
instance AccessControls1 Haskell.Field
|
||||
instance AccessControls1 Haskell.GADT
|
||||
instance AccessControls1 Haskell.InfixOperatorPattern
|
||||
instance AccessControls1 Haskell.NewType
|
||||
instance AccessControls1 Haskell.ImportDeclaration
|
||||
instance AccessControls1 Haskell.QualifiedImportDeclaration
|
||||
instance AccessControls1 Haskell.ImportAlias
|
||||
instance AccessControls1 Haskell.App
|
||||
instance AccessControls1 Haskell.InfixOperatorApp
|
||||
instance AccessControls1 Haskell.ListComprehension
|
||||
instance AccessControls1 Haskell.Generator
|
||||
instance AccessControls1 Haskell.ArithmeticSequence
|
||||
instance AccessControls1 Haskell.RightOperatorSection
|
||||
instance AccessControls1 Haskell.LeftOperatorSection
|
||||
instance AccessControls1 Haskell.BindPattern
|
||||
instance AccessControls1 Haskell.Lambda
|
||||
instance AccessControls1 Haskell.FixityAlt
|
||||
instance AccessControls1 Haskell.RecordWildCards
|
||||
instance AccessControls1 Haskell.Wildcard
|
||||
instance AccessControls1 Haskell.Let
|
||||
instance AccessControls1 Haskell.FieldBind
|
||||
instance AccessControls1 Haskell.Pragma
|
||||
instance AccessControls1 Haskell.Deriving
|
||||
instance AccessControls1 Haskell.ContextAlt
|
||||
instance AccessControls1 Haskell.Class
|
||||
instance AccessControls1 Haskell.Export
|
||||
instance AccessControls1 Haskell.ModuleExport
|
||||
instance AccessControls1 Haskell.QuotedName
|
||||
instance AccessControls1 Haskell.ScopedTypeVariables
|
||||
instance AccessControls1 Haskell.DefaultDeclaration
|
||||
instance AccessControls1 Haskell.VariableOperator
|
||||
instance AccessControls1 Haskell.ConstructorOperator
|
||||
instance AccessControls1 Haskell.TypeOperator
|
||||
instance AccessControls1 Haskell.PromotedTypeOperator
|
||||
instance AccessControls1 Haskell.VariableSymbol
|
||||
instance AccessControls1 Haskell.Import
|
||||
instance AccessControls1 Haskell.HiddenImport
|
||||
instance AccessControls1 Haskell.TypeApp
|
||||
instance AccessControls1 Haskell.TupleExpression
|
||||
instance AccessControls1 Haskell.TuplePattern
|
||||
instance AccessControls1 Haskell.ConstructorPattern
|
||||
instance AccessControls1 Haskell.Do
|
||||
instance AccessControls1 Haskell.PrefixNegation
|
||||
instance AccessControls1 Haskell.CPPDirective
|
||||
instance AccessControls1 Haskell.NamedFieldPun
|
||||
instance AccessControls1 Haskell.NegativeLiteral
|
||||
instance AccessControls1 Haskell.LambdaCase
|
||||
instance AccessControls1 Haskell.LabeledUpdate
|
||||
instance AccessControls1 Haskell.QualifiedTypeClassIdentifier
|
||||
instance AccessControls1 Haskell.QualifiedTypeConstructorIdentifier
|
||||
instance AccessControls1 Haskell.QualifiedConstructorIdentifier
|
||||
instance AccessControls1 Haskell.QualifiedInfixVariableIdentifier
|
||||
instance AccessControls1 Haskell.QualifiedModuleIdentifier
|
||||
instance AccessControls1 Haskell.QualifiedVariableIdentifier
|
||||
instance AccessControls1 Haskell.TypeVariableIdentifier
|
||||
instance AccessControls1 Haskell.TypeConstructorIdentifier
|
||||
instance AccessControls1 Haskell.ModuleIdentifier
|
||||
instance AccessControls1 Haskell.ConstructorIdentifier
|
||||
instance AccessControls1 Haskell.ImplicitParameterIdentifier
|
||||
instance AccessControls1 Haskell.InfixConstructorIdentifier
|
||||
instance AccessControls1 Haskell.InfixVariableIdentifier
|
||||
instance AccessControls1 Haskell.TypeClassIdentifier
|
||||
instance AccessControls1 Haskell.VariableIdentifier
|
||||
instance AccessControls1 Haskell.PrimitiveConstructorIdentifier
|
||||
instance AccessControls1 Haskell.PrimitiveVariableIdentifier
|
||||
instance AccessControls1 Haskell.AsPattern
|
||||
instance AccessControls1 Haskell.FieldPattern
|
||||
instance AccessControls1 Haskell.ViewPattern
|
||||
instance AccessControls1 Haskell.PatternGuard
|
||||
instance AccessControls1 Haskell.StrictPattern
|
||||
instance AccessControls1 Haskell.ListPattern
|
||||
instance AccessControls1 Haskell.TypePattern
|
||||
instance AccessControls1 Haskell.IrrefutablePattern
|
||||
instance AccessControls1 Haskell.CaseGuardPattern
|
||||
instance AccessControls1 Haskell.FunctionGuardPattern
|
||||
instance AccessControls1 Haskell.LabeledPattern
|
||||
instance AccessControls1 Haskell.Guard
|
||||
instance AccessControls1 Haskell.QuasiQuotation
|
||||
instance AccessControls1 Haskell.QuasiQuotationPattern
|
||||
instance AccessControls1 Haskell.QuasiQuotationType
|
||||
instance AccessControls1 Haskell.QuasiQuotationDeclaration
|
||||
instance AccessControls1 Haskell.QuasiQuotationExpression
|
||||
instance AccessControls1 Haskell.QuasiQuotationExpressionBody
|
||||
instance AccessControls1 Haskell.QuasiQuotationQuoter
|
||||
instance AccessControls1 Haskell.Splice
|
||||
instance AccessControls1 Haskell.StrictType
|
||||
instance AccessControls1 Haskell.Type
|
||||
instance AccessControls1 Haskell.TypeSynonym
|
||||
instance AccessControls1 Haskell.AnnotatedTypeVariable
|
||||
instance AccessControls1 Haskell.StandaloneDerivingInstance
|
||||
instance AccessControls1 Haskell.FunctionType
|
||||
instance AccessControls1 Haskell.TypeSignature
|
||||
instance AccessControls1 Haskell.ExpressionTypeSignature
|
||||
instance AccessControls1 Haskell.KindFunctionType
|
||||
instance AccessControls1 Haskell.Star
|
||||
instance AccessControls1 Haskell.EqualityConstraint
|
||||
instance AccessControls1 Haskell.TypeInstance
|
||||
instance AccessControls1 Haskell.TypeClassInstance
|
||||
instance AccessControls1 Haskell.TypeClass
|
||||
instance AccessControls1 Haskell.DefaultSignature
|
||||
instance AccessControls1 Haskell.TypeFamily
|
||||
instance AccessControls1 Haskell.StrictTypeVariable
|
||||
instance AccessControls1 Haskell.KindSignature
|
||||
instance AccessControls1 Haskell.Kind
|
||||
instance AccessControls1 Haskell.KindListType
|
||||
instance AccessControls1 Haskell.Instance
|
||||
instance AccessControls1 Haskell.KindTupleType
|
||||
instance AccessControls1 Haskell.FunctionalDependency
|
||||
|
||||
instance AccessControls1 Python.Alias
|
||||
instance AccessControls1 Python.Ellipsis
|
||||
instance AccessControls1 Python.FutureImport
|
||||
|
||||
@ -58,7 +58,7 @@ readBlobsFromGitRepo path oid excludePaths includePaths = liftIO . fmap catMaybe
|
||||
, not (pathIsMinified path)
|
||||
, path `notElem` excludePaths
|
||||
, null includePaths || path `elem` includePaths
|
||||
= Just . sourceBlob' path lang oid . Source.fromText <$> Git.catFile gitDir oid
|
||||
= Just . sourceBlob' path lang oid <$> Git.catFile gitDir oid
|
||||
blobFromTreeEntry _ _ = pure Nothing
|
||||
|
||||
sourceBlob' filepath language (Git.OID oid) source = makeBlob source filepath language oid
|
||||
|
||||
@ -1,935 +0,0 @@
|
||||
{-# LANGUAGE DataKinds, RankNTypes, TypeOperators #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME
|
||||
module Language.Haskell.Assignment
|
||||
( assignment
|
||||
, Syntax
|
||||
, Grammar
|
||||
, Term
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Assigning.Assignment hiding (Assignment, Error, count)
|
||||
import qualified Assigning.Assignment as Assignment
|
||||
import qualified Data.Abstract.Name as Name
|
||||
import Data.ByteString.Char8 (count)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Syntax
|
||||
(contextualize, emptyTerm, handleError, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError, postContextualize)
|
||||
import qualified Data.Syntax as Syntax
|
||||
import qualified Data.Syntax.Comment as Comment
|
||||
import qualified Data.Syntax.Declaration as Declaration
|
||||
import qualified Data.Syntax.Literal as Literal
|
||||
import qualified Data.Syntax.Statement as Statement
|
||||
import qualified Data.Syntax.Type as Type
|
||||
import qualified Data.Term as Term
|
||||
import qualified Language.Haskell.Syntax as Syntax
|
||||
import TreeSitter.Haskell as Grammar
|
||||
|
||||
type Syntax = '[
|
||||
Comment.Comment
|
||||
, Declaration.Constructor
|
||||
, Declaration.Datatype
|
||||
, Declaration.Function
|
||||
, Literal.Array
|
||||
, Literal.Character
|
||||
, Literal.Float
|
||||
, Literal.Integer
|
||||
, Literal.TextElement
|
||||
, Literal.Tuple
|
||||
, Statement.If
|
||||
, Statement.Match
|
||||
, Statement.Pattern
|
||||
, Syntax.AllConstructors
|
||||
, Syntax.AnnotatedTypeVariable
|
||||
, Syntax.App
|
||||
, Syntax.ArithmeticSequence
|
||||
, Syntax.AsPattern
|
||||
, Syntax.BindPattern
|
||||
, Syntax.CaseGuardPattern
|
||||
, Syntax.Class
|
||||
, Syntax.ConstructorIdentifier
|
||||
, Syntax.ConstructorOperator
|
||||
, Syntax.ConstructorPattern
|
||||
, Syntax.ConstructorSymbol
|
||||
, Syntax.Context
|
||||
, Syntax.ContextAlt
|
||||
, Syntax.CPPDirective
|
||||
, Syntax.DefaultDeclaration
|
||||
, Syntax.DefaultSignature
|
||||
, Syntax.Deriving
|
||||
, Syntax.Do
|
||||
, Syntax.Empty
|
||||
, Syntax.Error
|
||||
, Syntax.EqualityConstraint
|
||||
, Syntax.Export
|
||||
, Syntax.ExpressionTypeSignature
|
||||
, Syntax.Field
|
||||
, Syntax.FieldBind
|
||||
, Syntax.FieldPattern
|
||||
, Syntax.FixityAlt
|
||||
, Syntax.FunctionalDependency
|
||||
, Syntax.FunctionConstructor
|
||||
, Syntax.FunctionGuardPattern
|
||||
, Syntax.FunctionType
|
||||
, Syntax.GADT
|
||||
, Syntax.GADTConstructor
|
||||
, Syntax.Generator
|
||||
, Syntax.Guard
|
||||
, Syntax.HiddenImport
|
||||
, Syntax.Identifier
|
||||
, Syntax.InfixConstructorIdentifier
|
||||
, Syntax.InfixOperatorApp
|
||||
, Syntax.InfixVariableIdentifier
|
||||
, Syntax.ImplicitParameterIdentifier
|
||||
, Syntax.Import
|
||||
, Syntax.ImportAlias
|
||||
, Syntax.ImportDeclaration
|
||||
, Syntax.InfixDataConstructor
|
||||
, Syntax.InfixOperatorPattern
|
||||
, Syntax.Instance
|
||||
, Syntax.IrrefutablePattern
|
||||
, Syntax.Kind
|
||||
, Syntax.KindFunctionType
|
||||
, Syntax.KindListType
|
||||
, Syntax.KindParenthesizedConstructor
|
||||
, Syntax.KindSignature
|
||||
, Syntax.KindTupleType
|
||||
, Syntax.LabeledConstruction
|
||||
, Syntax.LabeledPattern
|
||||
, Syntax.LabeledUpdate
|
||||
, Syntax.Lambda
|
||||
, Syntax.LambdaCase
|
||||
, Syntax.LeftOperatorSection
|
||||
, Syntax.Let
|
||||
, Syntax.ListComprehension
|
||||
, Syntax.ListConstructor
|
||||
, Syntax.ListPattern
|
||||
, Syntax.Module
|
||||
, Syntax.ModuleExport
|
||||
, Syntax.ModuleIdentifier
|
||||
, Syntax.NamedFieldPun
|
||||
, Syntax.NegativeLiteral
|
||||
, Syntax.NewType
|
||||
, Syntax.PatternGuard
|
||||
, Syntax.Pragma
|
||||
, Syntax.PrefixNegation
|
||||
, Syntax.PrimitiveConstructorIdentifier
|
||||
, Syntax.PrimitiveVariableIdentifier
|
||||
, Syntax.PromotedTypeOperator
|
||||
, Syntax.QualifiedConstructorIdentifier
|
||||
, Syntax.QualifiedInfixVariableIdentifier
|
||||
, Syntax.QualifiedModuleIdentifier
|
||||
, Syntax.QualifiedImportDeclaration
|
||||
, Syntax.QualifiedTypeClassIdentifier
|
||||
, Syntax.QualifiedTypeConstructorIdentifier
|
||||
, Syntax.QualifiedVariableIdentifier
|
||||
, Syntax.QuasiQuotation
|
||||
, Syntax.QuasiQuotationDeclaration
|
||||
, Syntax.QuasiQuotationExpression
|
||||
, Syntax.QuasiQuotationExpressionBody
|
||||
, Syntax.QuasiQuotationPattern
|
||||
, Syntax.QuasiQuotationQuoter
|
||||
, Syntax.QuasiQuotationType
|
||||
, Syntax.QuotedName
|
||||
, Syntax.RecordDataConstructor
|
||||
, Syntax.RecordWildCards
|
||||
, Syntax.RightOperatorSection
|
||||
, Syntax.ScopedTypeVariables
|
||||
, Syntax.Splice
|
||||
, Syntax.StandaloneDerivingInstance
|
||||
, Syntax.Star
|
||||
, Syntax.StrictPattern
|
||||
, Syntax.StrictType
|
||||
, Syntax.StrictTypeVariable
|
||||
, Syntax.TupleConstructor
|
||||
, Syntax.TupleExpression
|
||||
, Syntax.TuplePattern
|
||||
, Syntax.Type
|
||||
, Syntax.TypeApp
|
||||
, Syntax.TypeClass
|
||||
, Syntax.TypeClassIdentifier
|
||||
, Syntax.TypeClassInstance
|
||||
, Syntax.TypeConstructorExport
|
||||
, Syntax.TypeConstructorIdentifier
|
||||
, Syntax.TypeFamily
|
||||
, Syntax.TypeInstance
|
||||
, Syntax.TypeOperator
|
||||
, Syntax.TypePattern
|
||||
, Syntax.TypeSignature
|
||||
, Syntax.TypeSynonym
|
||||
, Syntax.TypeVariableIdentifier
|
||||
, Syntax.UnitConstructor
|
||||
, Syntax.VariableIdentifier
|
||||
, Syntax.VariableOperator
|
||||
, Syntax.VariableSymbol
|
||||
, Syntax.ViewPattern
|
||||
, Syntax.Wildcard
|
||||
, Type.TypeParameters
|
||||
, []
|
||||
]
|
||||
|
||||
type Term = Term.Term (Sum Syntax) Loc
|
||||
type Assignment = Assignment.Assignment [] Grammar
|
||||
|
||||
assignment :: Assignment Term
|
||||
assignment = handleError $ module' <|> parseError
|
||||
|
||||
algebraicDatatypeDeclaration :: Assignment Term
|
||||
algebraicDatatypeDeclaration = makeTerm
|
||||
<$> symbol AlgebraicDatatypeDeclaration
|
||||
<*> children (Declaration.Datatype
|
||||
<$> (context' <|> emptyTerm)
|
||||
<*> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters <*> (kindSignature <|> emptyTerm)))
|
||||
<*> (constructors <|> pure [])
|
||||
<*> (term derivingClause <|> emptyTerm))
|
||||
where
|
||||
constructors = symbol Constructors *> children (manyTerm constructor)
|
||||
|
||||
allConstructors :: Assignment Term
|
||||
allConstructors = makeTerm <$> token AllConstructors <*> pure Syntax.AllConstructors
|
||||
|
||||
alternative :: Assignment Term
|
||||
alternative = makeTerm <$> symbol Alternative <*> children (Statement.Pattern <$> expression <*> expressions)
|
||||
|
||||
annotatedTypeVariable :: Assignment Term
|
||||
annotatedTypeVariable = makeTerm <$> symbol AnnotatedTypeVariable <*> children (Syntax.AnnotatedTypeVariable <$> typeVariableIdentifier <* token Annotation <*> expression)
|
||||
|
||||
app :: Assignment Term
|
||||
app = makeTerm <$> symbol FunctionApplication <*> children (Syntax.App <$> expression <*> (typeApp <|> emptyTerm) <*> expression)
|
||||
|
||||
arithmeticSequence :: Assignment Term
|
||||
arithmeticSequence = symbol ArithmeticSequence *> children ( enumFrom
|
||||
<|> enumFromThen
|
||||
<|> enumFromTo
|
||||
<|> enumFromThenTo)
|
||||
where
|
||||
enumFrom = makeTerm <$> symbol EnumFrom <*> children (Syntax.ArithmeticSequence <$> expression <*> pure Nothing <*> pure Nothing)
|
||||
enumFromThen = makeTerm <$> symbol EnumFromThen <*> children (Syntax.ArithmeticSequence <$> expression <*> fmap Just expression <*> pure Nothing)
|
||||
enumFromTo = makeTerm <$> symbol EnumFromTo <*> children (Syntax.ArithmeticSequence <$> expression <*> fmap Just expression <*> pure Nothing)
|
||||
enumFromThenTo = makeTerm <$> symbol EnumFromThenTo <*> children (Syntax.ArithmeticSequence <$> expression <*> fmap Just expression <*> fmap Just expression)
|
||||
|
||||
asPattern :: Assignment Term
|
||||
asPattern = makeTerm <$> symbol AsPattern <*> children (Syntax.AsPattern <$> expression <*> expression)
|
||||
|
||||
bindPattern :: Assignment Term
|
||||
bindPattern = makeTerm <$> symbol BindPattern <*> children (Syntax.BindPattern <$> manyTermsTill expression (symbol AnonLAngleMinus) <*> expression)
|
||||
|
||||
case' :: Assignment Term
|
||||
case' = makeTerm <$> symbol CaseExpression <*> children (Statement.Match <$> expression <*> expressions)
|
||||
|
||||
caseGuardPattern :: Assignment Term
|
||||
caseGuardPattern = makeTerm <$> symbol CaseGuardPattern <*> children (Syntax.CaseGuardPattern <$> manyTerm expression)
|
||||
|
||||
character :: Assignment Term
|
||||
character = makeTerm <$> symbol Char <*> (Literal.Character <$> source)
|
||||
|
||||
class' :: Assignment Term
|
||||
class' = makeTerm <$> symbol Class <*> children (Syntax.Class <$> manyTerm expression)
|
||||
|
||||
comment :: Assignment Term
|
||||
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
||||
|
||||
conditionalExpression :: Assignment Term
|
||||
conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (Statement.If <$> expression <*> expression <*> expression)
|
||||
|
||||
constructor :: Assignment Term
|
||||
constructor = (makeTerm <$> symbol DataConstructor <*> children (Declaration.Constructor <$> manyTerm (context' <|> scopedTypeVariables) <*> typeConstructor <*> typeParameters))
|
||||
<|> term (makeTerm <$> symbol RecordDataConstructor <*> children (Syntax.RecordDataConstructor <$> manyTerm (context' <|> scopedTypeVariables) <*> constructorIdentifier <*> term fields))
|
||||
<|> term (makeTerm <$> symbol InfixDataConstructor <*> children (Syntax.InfixDataConstructor <$> manyTerm (context' <|> scopedTypeVariables) <*> expression <*> expression <*> expression))
|
||||
|
||||
constructorIdentifier :: Assignment Term
|
||||
constructorIdentifier = makeTerm <$> symbol ConstructorIdentifier <*> (Syntax.ConstructorIdentifier . Name.name <$> source)
|
||||
|
||||
constructorOperator :: Assignment Term
|
||||
constructorOperator = makeTerm <$> symbol ConstructorOperator <*> children (Syntax.ConstructorOperator <$> expression)
|
||||
|
||||
constructorPattern :: Assignment Term
|
||||
constructorPattern = makeTerm <$> symbol ConstructorPattern <*> children (Syntax.ConstructorPattern <$> expressions)
|
||||
|
||||
constructorSymbol :: Assignment Term
|
||||
constructorSymbol = makeTerm <$> symbol ConstructorSymbol <*> (Syntax.ConstructorSymbol . Name.name <$> source)
|
||||
|
||||
context' :: Assignment Term
|
||||
context' = makeTerm <$> symbol Context <*> children (Syntax.ContextAlt <$> expressions)
|
||||
|
||||
contextPattern :: Assignment Term
|
||||
contextPattern = symbol ContextPattern *> children expressions
|
||||
|
||||
cppDirective :: Assignment Term
|
||||
cppDirective = makeTerm <$> symbol CppDirective <*> (Syntax.CPPDirective <$> source)
|
||||
|
||||
defaultDeclaration :: Assignment Term
|
||||
defaultDeclaration = makeTerm <$> symbol DefaultDeclaration <*> children (Syntax.DefaultDeclaration <$> manyTerm expression)
|
||||
|
||||
defaultSignature :: Assignment Term
|
||||
defaultSignature = makeTerm <$> symbol DefaultSignature <*> children (Syntax.DefaultSignature <$> manyTermsTill expression (symbol Annotation) <* token Annotation <*> manyTerm (context' <|> scopedTypeVariables) <*> expressions)
|
||||
|
||||
derivingClause :: Assignment Term
|
||||
derivingClause = makeTerm <$> symbol Deriving <*> children (Syntax.Deriving <$> manyTerm expression)
|
||||
|
||||
do' :: Assignment Term
|
||||
do' = makeTerm <$> symbol Do <*> children (Syntax.Do <$> manyTerm expression)
|
||||
|
||||
equalityConstraint :: Assignment Term
|
||||
equalityConstraint = makeTerm <$> symbol EqualityConstraint <*> children (Syntax.EqualityConstraint <$> equalityLhs <*> equalityRhs)
|
||||
where
|
||||
equalityLhs = symbol EqualityLhs *> children expression
|
||||
equalityRhs = symbol EqualityRhs *> children expression
|
||||
|
||||
export :: Assignment Term
|
||||
export = makeTerm <$> symbol Export <*> children (Syntax.Export <$> expressions)
|
||||
|
||||
expression' :: Assignment Term
|
||||
expression' = symbol Expression *> children expressions
|
||||
|
||||
expressions :: Assignment Term
|
||||
expressions = makeTerm'' <$> location <*> manyTerm expression
|
||||
|
||||
expression :: Assignment Term
|
||||
expression = term (handleError (choice expressionChoices))
|
||||
|
||||
expressionChoices :: [Assignment Term]
|
||||
expressionChoices = [
|
||||
algebraicDatatypeDeclaration
|
||||
, allConstructors
|
||||
, alternative
|
||||
, annotatedTypeVariable
|
||||
, app
|
||||
, arithmeticSequence
|
||||
, asPattern
|
||||
, bindPattern
|
||||
, case'
|
||||
, caseGuardPattern
|
||||
, character
|
||||
, class'
|
||||
, comment
|
||||
, conditionalExpression
|
||||
, context'
|
||||
, contextPattern
|
||||
, constructorIdentifier
|
||||
, constructorOperator
|
||||
, constructorPattern
|
||||
, constructorSymbol
|
||||
, cppDirective
|
||||
, defaultDeclaration
|
||||
, defaultSignature
|
||||
, derivingClause
|
||||
, do'
|
||||
, equalityConstraint
|
||||
, expression'
|
||||
, expressionTypeSignature
|
||||
, fields
|
||||
, fieldBind
|
||||
, fieldPattern
|
||||
, fixityDeclaration
|
||||
, float
|
||||
, functionalDependency
|
||||
, functionConstructor
|
||||
, functionDeclaration
|
||||
, functionGuardPattern
|
||||
, functionType
|
||||
, gadtConstructor
|
||||
, gadtDeclaration
|
||||
, generator
|
||||
, guard'
|
||||
, implicitParameterIdentifier
|
||||
, importAlias
|
||||
, importDeclaration
|
||||
, infixConstructorIdentifier
|
||||
, infixOperatorApp
|
||||
, infixOperatorPattern
|
||||
, infixVariableIdentifier
|
||||
, instance'
|
||||
, integer
|
||||
, irrefutablePattern
|
||||
, kind
|
||||
, kindListType
|
||||
, kindFunctionType
|
||||
, kindParenthesizedConstructor
|
||||
, kindSignature
|
||||
, kindTupleType
|
||||
, labeledConstruction
|
||||
, labeledPattern
|
||||
, labeledUpdate
|
||||
, lambda
|
||||
, lambdaCase
|
||||
, letExpression
|
||||
, letStatement
|
||||
, listConstructor
|
||||
, listComprehension
|
||||
, listExpression
|
||||
, listPattern
|
||||
, listType
|
||||
, moduleExport
|
||||
, moduleIdentifier
|
||||
, namedFieldPun
|
||||
, negativeLiteral
|
||||
, newType
|
||||
, operator
|
||||
, operatorSection
|
||||
, parenthesizedConstructorOperator
|
||||
, parenthesizedExpression
|
||||
, parenthesizedPattern
|
||||
, parenthesizedTypePattern
|
||||
, pattern'
|
||||
, patternGuard
|
||||
, pragma
|
||||
, prefixNegation
|
||||
, primitiveConstructorIdentifier
|
||||
, primitiveVariableIdentifier
|
||||
, promotedTypeOperator
|
||||
, qualifiedConstructorIdentifier
|
||||
, qualifiedImportDeclaration
|
||||
, qualifiedInfixVariableIdentifier
|
||||
, qualifiedModuleIdentifier
|
||||
, qualifiedTypeClassIdentifier
|
||||
, qualifiedTypeConstructorIdentifier
|
||||
, qualifiedVariableIdentifier
|
||||
, quasiQuotation
|
||||
, quasiQuotationDeclaration
|
||||
, quasiQuotationExpression
|
||||
, quasiQuotationExpressionBody
|
||||
, quasiQuotationPattern
|
||||
, quasiQuotationQuoter
|
||||
, quasiQuotationType
|
||||
, quotedName
|
||||
, recordWildCards
|
||||
, scopedTypeVariables
|
||||
, splice
|
||||
, standaloneDerivingInstance
|
||||
, star
|
||||
, strictPattern
|
||||
, strictType
|
||||
, string
|
||||
, tuple
|
||||
, tuplePattern
|
||||
, tupleType
|
||||
, type'
|
||||
, type''
|
||||
, typeApp
|
||||
, typeClass
|
||||
, typeClassIdentifier
|
||||
, typeClassInstance
|
||||
, typeConstructor
|
||||
, typeFamily
|
||||
, typeInstance
|
||||
, typePattern
|
||||
, typeConstructorExport
|
||||
, typeConstructorIdentifier
|
||||
, typeOperator
|
||||
, typeSignature
|
||||
, typeSynonymDeclaration
|
||||
, typeVariableIdentifier
|
||||
, tuplingConstructor
|
||||
, unitConstructor
|
||||
, variableIdentifier
|
||||
, variableOperator
|
||||
, variableSymbol
|
||||
, viewPattern
|
||||
, where'
|
||||
, wildcard
|
||||
]
|
||||
|
||||
expressionTypeSignature :: Assignment Term
|
||||
expressionTypeSignature = makeTerm <$> symbol ExpressionTypeSignature <*> children (Syntax.ExpressionTypeSignature <$> manyTermsTill expression (symbol Annotation) <* token Annotation <*> manyTerm (context' <|> scopedTypeVariables) <*> expressions)
|
||||
|
||||
fields :: Assignment Term
|
||||
fields = makeTerm <$> symbol Fields <*> children (manyTerm field)
|
||||
|
||||
field :: Assignment Term
|
||||
field = makeTerm
|
||||
<$> symbol Field
|
||||
<*> children (Syntax.Field
|
||||
<$> variableIdentifiers
|
||||
<* token Annotation
|
||||
<*> fieldType)
|
||||
where
|
||||
fieldType = makeTerm <$> location <*> (Syntax.Type <$> term (type' <|> typeVariableIdentifier) <*> typeParameters <*> (kindSignature <|> emptyTerm))
|
||||
|
||||
fieldBind :: Assignment Term
|
||||
fieldBind = makeTerm <$> symbol FieldBind <*> children (Syntax.FieldBind <$> expression <*> expression)
|
||||
|
||||
fieldPattern :: Assignment Term
|
||||
fieldPattern = makeTerm <$> symbol FieldPattern <*> children (Syntax.FieldPattern <$> expression <*> expressions)
|
||||
|
||||
fixityDeclaration :: Assignment Term
|
||||
fixityDeclaration = makeTerm <$> symbol FixityDeclaration <*> children (Syntax.FixityAlt <$> (integer <|> emptyTerm) <*> manyTerm expression)
|
||||
|
||||
float :: Assignment Term
|
||||
float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
|
||||
|
||||
functionalDependency :: Assignment Term
|
||||
functionalDependency = makeTerm <$> symbol FunctionalDependency <*> children (Syntax.FunctionalDependency <$> expressions)
|
||||
|
||||
functionBody :: Assignment Term
|
||||
functionBody = makeTerm <$> symbol FunctionBody <*> children (manyTerm expression)
|
||||
|
||||
functionConstructor :: Assignment Term
|
||||
functionConstructor = makeTerm <$> token FunctionConstructor <*> pure Syntax.FunctionConstructor
|
||||
|
||||
functionDeclaration :: Assignment Term
|
||||
functionDeclaration = makeTerm
|
||||
<$> symbol FunctionDeclaration
|
||||
<*> children (Declaration.Function []
|
||||
<$> term expression
|
||||
<*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
|
||||
<*> functionBody)
|
||||
|
||||
functionGuardPattern :: Assignment Term
|
||||
functionGuardPattern = makeTerm <$> symbol FunctionGuardPattern <*> children (Syntax.FunctionGuardPattern <$> manyTerm expression)
|
||||
|
||||
functionType :: Assignment Term
|
||||
functionType = makeTerm <$> symbol FunctionType <*> children (Syntax.FunctionType <$> expression <*> expression)
|
||||
|
||||
gadtConstructor :: Assignment Term
|
||||
gadtConstructor = makeTerm
|
||||
<$> symbol GadtConstructor
|
||||
<*> children (Syntax.GADTConstructor
|
||||
<$> (context' <|> emptyTerm)
|
||||
<*> expression
|
||||
<* token Annotation
|
||||
<*> expressions)
|
||||
|
||||
gadtDeclaration :: Assignment Term
|
||||
gadtDeclaration = makeTerm
|
||||
<$> symbol GadtDeclaration
|
||||
<*> children (Syntax.GADT
|
||||
<$> (context' <|> emptyTerm)
|
||||
<*> (makeTerm <$> location <*> (Syntax.Type <$> typeConstructor <*> typeParameters' <*> (kindSignature <|> emptyTerm)))
|
||||
<*> where')
|
||||
where
|
||||
typeParameters' = makeTerm <$> location <*> manyTermsTill expression (symbol KindSignature <|> symbol Where')
|
||||
|
||||
generator :: Assignment Term
|
||||
generator = makeTerm <$> symbol Generator <*> children (Syntax.Generator <$> expression <*> expression)
|
||||
|
||||
guard' :: Assignment Term
|
||||
guard' = makeTerm <$> symbol Guard <*> children (Syntax.Guard <$> expressions)
|
||||
|
||||
hiddenImport :: Assignment Term
|
||||
hiddenImport = makeTerm <$> symbol Import <*> children (Syntax.HiddenImport <$> expressions)
|
||||
|
||||
hiddenImportSpec :: Assignment [Term]
|
||||
hiddenImportSpec = symbol HiddenImportSpec *> children (manyTerm hiddenImport)
|
||||
|
||||
implicitParameterIdentifier :: Assignment Term
|
||||
implicitParameterIdentifier = makeTerm <$> symbol ImplicitParameterIdentifier <*> (Syntax.ImplicitParameterIdentifier . Name.name <$> source)
|
||||
|
||||
import' :: Assignment Term
|
||||
import' = makeTerm <$> symbol Import <*> children (Syntax.Import <$> expressions)
|
||||
|
||||
importAlias :: Assignment Term
|
||||
importAlias = makeTerm <$> symbol ImportAlias <*> children (Syntax.ImportAlias <$> expression <*> expression)
|
||||
|
||||
importDeclaration :: Assignment Term
|
||||
importDeclaration = makeTerm
|
||||
<$> symbol ImportDeclaration
|
||||
<*> children (Syntax.ImportDeclaration
|
||||
<$> (packageQualifiedImport <|> emptyTerm)
|
||||
<*> expression
|
||||
<*> (importSpec <|> hiddenImportSpec <|> pure []))
|
||||
|
||||
importSpec :: Assignment [Term]
|
||||
importSpec = symbol ImportSpec *> children (manyTerm import')
|
||||
|
||||
inClause :: Assignment Term
|
||||
inClause = symbol InClause *> children expressions
|
||||
|
||||
infixConstructorIdentifier :: Assignment Term
|
||||
infixConstructorIdentifier = makeTerm <$> symbol InfixConstructorIdentifier <*> children (Syntax.InfixConstructorIdentifier . Name.name <$> source)
|
||||
|
||||
infixOperatorApp :: Assignment Term
|
||||
infixOperatorApp = makeTerm <$> symbol InfixOperatorApplication <*> children (Syntax.InfixOperatorApp <$> expression <*> (typeApp <|> emptyTerm) <*> expression <*> (expressions <|> emptyTerm))
|
||||
|
||||
infixOperatorPattern :: Assignment Term
|
||||
infixOperatorPattern = makeTerm <$> symbol InfixOperatorPattern <*> children (Syntax.InfixOperatorPattern <$> expression <*> operator <*> expression)
|
||||
|
||||
infixVariableIdentifier :: Assignment Term
|
||||
infixVariableIdentifier = makeTerm <$> symbol InfixVariableIdentifier <*> children (Syntax.InfixVariableIdentifier . Name.name <$> source)
|
||||
|
||||
instance' :: Assignment Term
|
||||
instance' = makeTerm <$> symbol Instance <*> children (Syntax.Instance <$> expressions)
|
||||
|
||||
integer :: Assignment Term
|
||||
integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
|
||||
|
||||
irrefutablePattern :: Assignment Term
|
||||
irrefutablePattern = makeTerm <$> symbol IrrefutablePattern <*> children (Syntax.IrrefutablePattern <$> expression)
|
||||
|
||||
kind :: Assignment Term
|
||||
kind = kind'
|
||||
<|> kindFunctionType
|
||||
<|> kindListType
|
||||
<|> kindParenthesizedConstructor
|
||||
<|> kindSignature
|
||||
<|> kindTupleType
|
||||
<|> star
|
||||
|
||||
kind' :: Assignment Term
|
||||
kind' = makeTerm <$> symbol Kind <*> children (Syntax.Kind <$> expression)
|
||||
|
||||
kindFunctionType :: Assignment Term
|
||||
kindFunctionType = makeTerm <$> symbol KindFunctionType <*> children (Syntax.KindFunctionType <$> expression <*> expression)
|
||||
|
||||
kindListType :: Assignment Term
|
||||
kindListType = makeTerm <$> symbol KindListType <*> children (Syntax.KindListType <$> expression)
|
||||
|
||||
kindParenthesizedConstructor :: Assignment Term
|
||||
kindParenthesizedConstructor = makeTerm <$> symbol KindParenthesizedConstructor <*> children (Syntax.KindParenthesizedConstructor <$> expression)
|
||||
|
||||
kindSignature :: Assignment Term
|
||||
kindSignature = makeTerm <$> symbol KindSignature <*> children (Syntax.KindSignature <$ token Annotation <*> expression)
|
||||
|
||||
kindTupleType :: Assignment Term
|
||||
kindTupleType = makeTerm <$> symbol KindTupleType <*> children (Syntax.KindTupleType <$> manyTerm expression)
|
||||
|
||||
labeledConstruction :: Assignment Term
|
||||
labeledConstruction = makeTerm <$> symbol LabeledConstruction <*> children (Syntax.LabeledConstruction <$> expression <*> manyTerm expression)
|
||||
|
||||
labeledPattern :: Assignment Term
|
||||
labeledPattern = makeTerm <$> symbol LabeledPattern <*> children (Syntax.LabeledPattern <$> expressions)
|
||||
|
||||
labeledUpdate :: Assignment Term
|
||||
labeledUpdate = makeTerm <$> symbol LabeledUpdate <*> children (Syntax.LabeledUpdate <$> manyTerm expression)
|
||||
|
||||
lambda :: Assignment Term
|
||||
lambda = makeTerm <$> symbol Lambda <*> children (Syntax.Lambda <$> lambdaHead <*> lambdaBody)
|
||||
where
|
||||
lambdaHead = symbol LambdaHead *> children expressions
|
||||
lambdaBody = symbol LambdaBody *> children expressions
|
||||
|
||||
lambdaCase :: Assignment Term
|
||||
lambdaCase = makeTerm <$> symbol LambdaCase <*> children (Syntax.LambdaCase <$> manyTerm expression)
|
||||
|
||||
letExpression :: Assignment Term
|
||||
letExpression = makeTerm <$> symbol LetExpression <*> children (Syntax.Let <$> manyTermsTill expression (symbol InClause) <*> inClause)
|
||||
|
||||
letStatement :: Assignment Term
|
||||
letStatement = makeTerm <$> symbol LetStatement <*> children (Syntax.Let <$> manyTerm expression <*> emptyTerm)
|
||||
|
||||
listComprehension :: Assignment Term
|
||||
listComprehension = makeTerm <$> symbol ListComprehension <*> children (Syntax.ListComprehension <$> expression <*> manyTerm expression)
|
||||
|
||||
listConstructor :: Assignment Term
|
||||
listConstructor = makeTerm <$> token ListConstructor <*> pure Syntax.ListConstructor
|
||||
|
||||
listExpression :: Assignment Term
|
||||
listExpression = makeTerm <$> symbol ListExpression <*> children (Literal.Array <$> manyTerm listElement)
|
||||
where listElement = symbol Expression *> children expression
|
||||
|
||||
listPattern :: Assignment Term
|
||||
listPattern = makeTerm <$> symbol ListPattern <*> children (Syntax.ListPattern <$> expressions)
|
||||
|
||||
listType :: Assignment Term
|
||||
listType = makeTerm <$> symbol ListType <*> children (Literal.Array <$> manyTerm type')
|
||||
|
||||
module' :: Assignment Term
|
||||
module' = makeTerm
|
||||
<$> symbol Module
|
||||
<*> children (Syntax.Module
|
||||
<$> manyTerm (comment <|> pragma)
|
||||
<*> term (moduleIdentifier <|> qualifiedModuleIdentifier <|> emptyTerm)
|
||||
<*> moduleExports
|
||||
<*> term (where' <|> expressions <|> emptyTerm))
|
||||
where
|
||||
moduleExports = symbol ModuleExports *> children (manyTerm export)
|
||||
<|> pure []
|
||||
|
||||
moduleExport :: Assignment Term
|
||||
moduleExport = makeTerm <$> symbol ModuleExport <*> children (Syntax.ModuleExport <$> expressions)
|
||||
|
||||
moduleIdentifier :: Assignment Term
|
||||
moduleIdentifier = makeTerm <$> symbol ModuleIdentifier <*> (Syntax.ModuleIdentifier . Name.name <$> source)
|
||||
|
||||
namedFieldPun :: Assignment Term
|
||||
namedFieldPun = makeTerm <$> symbol NamedFieldPun <*> children (Syntax.NamedFieldPun <$> expression)
|
||||
|
||||
negativeLiteral :: Assignment Term
|
||||
negativeLiteral = makeTerm <$> symbol NegativeLiteral <*> children (Syntax.NegativeLiteral <$> expression)
|
||||
|
||||
newConstructor :: Assignment Term
|
||||
newConstructor = makeTerm <$> symbol NewConstructor <*> children (Declaration.Constructor <$> manyTerm (context' <|> scopedTypeVariables) <*> expression <*> expressions)
|
||||
|
||||
newType :: Assignment Term
|
||||
newType = makeTerm <$> symbol NewtypeDeclaration <*> children (Syntax.NewType <$> manyTerm (context' <|> scopedTypeVariables) <*> typeLeft <*> newConstructor <*> (derivingClause <|> emptyTerm))
|
||||
where
|
||||
typeLeft = makeTerm <$> location <*> manyTermsTill expression (symbol NewConstructor)
|
||||
|
||||
operator :: Assignment Term
|
||||
operator = constructorOperator
|
||||
<|> typeOperator
|
||||
<|> promotedTypeOperator
|
||||
<|> variableOperator
|
||||
|
||||
operatorSection :: Assignment Term
|
||||
operatorSection = (makeTerm <$> symbol RightOperatorSection <*> children (Syntax.RightOperatorSection <$> expression <*> expression))
|
||||
<|> (makeTerm <$> symbol LeftOperatorSection <*> children (Syntax.LeftOperatorSection <$> expression <*> expression))
|
||||
|
||||
packageQualifiedImport :: Assignment Term
|
||||
packageQualifiedImport = makeTerm <$> symbol PackageQualifiedImport <*> (Literal.TextElement <$> source)
|
||||
|
||||
parenthesizedConstructorOperator :: Assignment Term
|
||||
parenthesizedConstructorOperator = symbol ParenthesizedConstructorOperator *> children expression
|
||||
|
||||
parenthesizedExpression :: Assignment Term
|
||||
parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
|
||||
|
||||
parenthesizedPattern :: Assignment Term
|
||||
parenthesizedPattern = symbol ParenthesizedPattern *> children expressions
|
||||
|
||||
parenthesizedTypePattern :: Assignment Term
|
||||
parenthesizedTypePattern = symbol ParenthesizedTypePattern *> children expressions
|
||||
|
||||
pattern' :: Assignment Term
|
||||
pattern' = symbol Pattern *> children expressions
|
||||
|
||||
patternGuard :: Assignment Term
|
||||
patternGuard = makeTerm <$> symbol PatternGuard <*> children (Syntax.PatternGuard <$> expression <*> (expression <|> emptyTerm))
|
||||
|
||||
pragma :: Assignment Term
|
||||
pragma = makeTerm <$> symbol Pragma <*> (Syntax.Pragma <$> source)
|
||||
|
||||
prefixNegation :: Assignment Term
|
||||
prefixNegation = makeTerm <$> symbol PrefixNegation <*> children (Syntax.PrefixNegation <$> expression)
|
||||
|
||||
primitiveConstructorIdentifier :: Assignment Term
|
||||
primitiveConstructorIdentifier = makeTerm <$> symbol PrimitiveConstructorIdentifier <*> (Syntax.PrimitiveConstructorIdentifier . Name.name <$> source)
|
||||
|
||||
primitiveVariableIdentifier :: Assignment Term
|
||||
primitiveVariableIdentifier = makeTerm <$> symbol PrimitiveVariableIdentifier <*> (Syntax.PrimitiveVariableIdentifier . Name.name <$> source)
|
||||
|
||||
promotedTypeOperator :: Assignment Term
|
||||
promotedTypeOperator = makeTerm <$> symbol PromotedTypeOperator <*> children (Syntax.PromotedTypeOperator <$> expression)
|
||||
|
||||
qualifiedConstructorIdentifier :: Assignment Term
|
||||
qualifiedConstructorIdentifier = makeTerm <$> symbol QualifiedConstructorIdentifier <*> children (Syntax.QualifiedConstructorIdentifier <$> someTerm' expression)
|
||||
|
||||
qualifiedImportDeclaration :: Assignment Term
|
||||
qualifiedImportDeclaration = makeTerm
|
||||
<$> symbol QualifiedImportDeclaration
|
||||
<*> children (Syntax.QualifiedImportDeclaration
|
||||
<$> (packageQualifiedImport <|> emptyTerm)
|
||||
<*> expression
|
||||
<*> (importSpec <|> hiddenImportSpec <|> pure []))
|
||||
|
||||
qualifiedInfixVariableIdentifier :: Assignment Term
|
||||
qualifiedInfixVariableIdentifier = makeTerm <$> symbol QualifiedInfixVariableIdentifier <*> children (Syntax.QualifiedInfixVariableIdentifier <$> someTerm' expression)
|
||||
|
||||
qualifiedModuleIdentifier :: Assignment Term
|
||||
qualifiedModuleIdentifier = makeTerm <$> symbol QualifiedModuleIdentifier <*> children (Syntax.QualifiedModuleIdentifier <$> someTerm' expression)
|
||||
|
||||
qualifiedTypeClassIdentifier :: Assignment Term
|
||||
qualifiedTypeClassIdentifier = makeTerm <$> symbol QualifiedTypeClassIdentifier <*> children (Syntax.QualifiedTypeClassIdentifier <$> someTerm' expression)
|
||||
|
||||
qualifiedTypeConstructorIdentifier :: Assignment Term
|
||||
qualifiedTypeConstructorIdentifier = makeTerm <$> symbol QualifiedTypeConstructorIdentifier <*> children (Syntax.QualifiedTypeConstructorIdentifier <$> someTerm' expression)
|
||||
|
||||
qualifiedVariableIdentifier :: Assignment Term
|
||||
qualifiedVariableIdentifier = makeTerm <$> symbol QualifiedVariableIdentifier <*> children (Syntax.QualifiedVariableIdentifier <$> someTerm' expression)
|
||||
|
||||
quasiQuotation :: Assignment Term
|
||||
quasiQuotation = makeTerm <$> symbol QuasiQuotation <*> children (Syntax.QuasiQuotation <$> (expression <|> emptyTerm) <*> expression)
|
||||
|
||||
quasiQuotationDeclaration :: Assignment Term
|
||||
quasiQuotationDeclaration = makeTerm <$> token QuasiQuotationDeclaration <*> pure Syntax.QuasiQuotationDeclaration
|
||||
|
||||
quasiQuotationExpression :: Assignment Term
|
||||
quasiQuotationExpression = makeTerm <$> token QuasiQuotationExpression <*> pure Syntax.QuasiQuotationExpression
|
||||
|
||||
quasiQuotationExpressionBody :: Assignment Term
|
||||
quasiQuotationExpressionBody = makeTerm <$> symbol QuasiQuotationExpressionBody <*> (Syntax.QuasiQuotationExpressionBody . Name.name <$> source)
|
||||
|
||||
quasiQuotationPattern :: Assignment Term
|
||||
quasiQuotationPattern = makeTerm <$> token QuasiQuotationPattern <*> pure Syntax.QuasiQuotationPattern
|
||||
|
||||
quasiQuotationQuoter :: Assignment Term
|
||||
quasiQuotationQuoter = makeTerm <$> symbol QuasiQuotationQuoter <*> (Syntax.QuasiQuotationQuoter . Name.name <$> source)
|
||||
|
||||
quasiQuotationType :: Assignment Term
|
||||
quasiQuotationType = makeTerm <$> token QuasiQuotationType <*> pure Syntax.QuasiQuotationType
|
||||
|
||||
quotedName :: Assignment Term
|
||||
quotedName = makeTerm <$> symbol QuotedName <*> children (Syntax.QuotedName <$> expression)
|
||||
|
||||
recordWildCards :: Assignment Term
|
||||
recordWildCards = makeTerm <$> symbol RecordWildCards <*> (Syntax.RecordWildCards <$ source)
|
||||
|
||||
scopedTypeVariables :: Assignment Term
|
||||
scopedTypeVariables = makeTerm <$> symbol ScopedTypeVariables <*> children (Syntax.ScopedTypeVariables <$> expressions <* token Dot)
|
||||
|
||||
splice :: Assignment Term
|
||||
splice = makeTerm <$> symbol Splice <*> children (Syntax.Splice <$> expression)
|
||||
|
||||
standaloneDerivingInstance :: Assignment Term
|
||||
standaloneDerivingInstance = makeTerm <$> symbol StandaloneDerivingDeclaration <*> children (Syntax.StandaloneDerivingInstance <$> manyTerm (context' <|> scopedTypeVariables) <*> expression <*> instance')
|
||||
where
|
||||
instance' = symbol Instance *> children expressions
|
||||
|
||||
star :: Assignment Term
|
||||
star = makeTerm <$> token Star <*> pure Syntax.Star
|
||||
|
||||
strictPattern :: Assignment Term
|
||||
strictPattern = makeTerm <$> symbol StrictPattern <*> children (Syntax.StrictPattern <$> expression)
|
||||
|
||||
strictType :: Assignment Term
|
||||
strictType = makeTerm'
|
||||
<$> symbol StrictType
|
||||
<*> children ( (inject <$> (Syntax.StrictType <$> typeConstructor <*> typeParameters))
|
||||
<|> (inject <$> (Syntax.StrictTypeVariable <$> expression)))
|
||||
|
||||
string :: Assignment Term
|
||||
string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
|
||||
|
||||
tuple :: Assignment Term
|
||||
tuple = makeTerm <$> symbol TupleExpression <*> children (Syntax.TupleExpression <$> manyTerm expression)
|
||||
|
||||
tuplePattern :: Assignment Term
|
||||
tuplePattern = makeTerm <$> symbol TuplePattern <*> children (Syntax.TuplePattern <$> manyTerm expression)
|
||||
|
||||
tupleType :: Assignment Term
|
||||
tupleType = makeTerm <$> symbol TupleType <*> children (Literal.Tuple <$> manyTerm expression)
|
||||
|
||||
tuplingConstructor :: Assignment Term
|
||||
tuplingConstructor = makeTerm <$> symbol TuplingConstructor <*> (tupleWithArity <$> rawSource)
|
||||
-- a tuple (,) has arity two, but only one comma, so apply the successor to the count of commas for the correct arity.
|
||||
where tupleWithArity = Syntax.TupleConstructor . succ . count ','
|
||||
|
||||
type' :: Assignment Term
|
||||
type' = class'
|
||||
<|> fields
|
||||
<|> functionType
|
||||
<|> parenthesizedTypePattern
|
||||
<|> strictType
|
||||
<|> type''
|
||||
<|> typeConstructor
|
||||
<|> typePattern
|
||||
|
||||
type'' :: Assignment Term
|
||||
type'' = makeTerm
|
||||
<$> symbol Type
|
||||
<*> children (Syntax.Type <$> expression <*> typeParameters <*> (kindSignature <|> emptyTerm))
|
||||
|
||||
typeApp :: Assignment Term
|
||||
typeApp = makeTerm <$> symbol TypeApplication <*> children (Syntax.TypeApp <$> expression)
|
||||
|
||||
typeClass :: Assignment Term
|
||||
typeClass = makeTerm <$> symbol TypeClassDeclaration <*> children (Syntax.TypeClass
|
||||
<$> (context' <|> emptyTerm)
|
||||
<*> expression
|
||||
<*> manyTermsTill expression (symbol Where)
|
||||
<*> where')
|
||||
|
||||
typeClassIdentifier :: Assignment Term
|
||||
typeClassIdentifier = makeTerm <$> symbol TypeClassIdentifier <*> (Syntax.TypeClassIdentifier . Name.name <$> source)
|
||||
|
||||
typeClassInstance :: Assignment Term
|
||||
typeClassInstance = makeTerm <$> symbol TypeClassInstanceDeclaration <*> children (Syntax.TypeClassInstance
|
||||
<$> manyTerm (context' <|> scopedTypeVariables)
|
||||
<*> expression
|
||||
<*> expression
|
||||
<*> (where' <|> emptyTerm))
|
||||
|
||||
typeConstructor :: Assignment Term
|
||||
typeConstructor = constructorIdentifier
|
||||
<|> functionConstructor
|
||||
<|> listConstructor
|
||||
<|> listType
|
||||
<|> qualifiedModuleIdentifier
|
||||
<|> qualifiedTypeClassIdentifier
|
||||
<|> qualifiedTypeConstructorIdentifier
|
||||
<|> quotedName
|
||||
<|> tupleType
|
||||
<|> tuplingConstructor
|
||||
<|> typeClassIdentifier
|
||||
<|> typeConstructorIdentifier
|
||||
<|> unitConstructor
|
||||
|
||||
typeConstructorExport :: Assignment Term
|
||||
typeConstructorExport = makeTerm <$> symbol TypeConstructorExport <*> children (Syntax.TypeConstructorExport <$> expression)
|
||||
|
||||
typeConstructorIdentifier :: Assignment Term
|
||||
typeConstructorIdentifier = makeTerm <$> symbol TypeConstructorIdentifier <*> (Syntax.TypeConstructorIdentifier . Name.name <$> source)
|
||||
|
||||
typeFamily :: Assignment Term
|
||||
typeFamily = makeTerm <$> symbol TypeFamilyDeclaration <*> children (Syntax.TypeFamily <$> expression <*> manyTermsTill expression typeFamilySeperator <*> (typeSignature <|> kindSignature <|> emptyTerm) <*> (where' <|> emptyTerm))
|
||||
where
|
||||
typeFamilySeperator = symbol TypeSignature
|
||||
<|> symbol KindSignature
|
||||
<|> symbol Where
|
||||
|
||||
typeInstance :: Assignment Term
|
||||
typeInstance = makeTerm <$> symbol TypeInstanceDeclaration <*> children (Syntax.TypeInstance <$> typeInstanceType <*> typeInstanceBody)
|
||||
where
|
||||
typeInstanceType = makeTerm <$> location <*> manyTermsTill expression (symbol TypeInstanceBody)
|
||||
typeInstanceBody = symbol TypeInstanceBody *> children expressions
|
||||
|
||||
typeOperator :: Assignment Term
|
||||
typeOperator = makeTerm <$> symbol TypeOperator <*> (Syntax.TypeOperator . Name.name <$> source)
|
||||
|
||||
typeSignature :: Assignment Term
|
||||
typeSignature = makeTerm <$> symbol TypeSignature <*> children (Syntax.TypeSignature <$> manyTermsTill expression (symbol Annotation) <* token Annotation <*> manyTerm (context' <|> scopedTypeVariables) <*> expressions)
|
||||
|
||||
typeParameters :: Assignment Term
|
||||
typeParameters = makeTerm <$> location <*> (Type.TypeParameters <$> (manyTermsTill expression (symbol Annotation) <|> manyTerm expression))
|
||||
|
||||
typePattern :: Assignment Term
|
||||
typePattern = makeTerm <$> symbol TypePattern <*> children (Syntax.TypePattern <$> expressions)
|
||||
|
||||
typeSynonymDeclaration :: Assignment Term
|
||||
typeSynonymDeclaration = makeTerm
|
||||
<$> symbol TypeSynonymDeclaration
|
||||
<*> children (typeSynonym <$> typeLeft <*> typeRight)
|
||||
where
|
||||
typeLeft = makeTerm <$> location <*> manyTill expression typeRightSeperator
|
||||
typeRight = (symbol TypeSynonymBody *> children ((,) <$> manyTerm (context' <|> scopedTypeVariables) <*> expression))
|
||||
<|> ((,) [] <$> typeSignature)
|
||||
<|> ((,) [] <$> kindSignature)
|
||||
typeRightSeperator = symbol TypeSynonymBody
|
||||
<|> symbol TypeSignature
|
||||
<|> symbol KindSignature
|
||||
typeSynonym typeLeft (contexts, typeRight) = Syntax.TypeSynonym typeLeft contexts typeRight
|
||||
|
||||
typeVariableIdentifier :: Assignment Term
|
||||
typeVariableIdentifier = makeTerm <$> symbol TypeVariableIdentifier <*> (Syntax.TypeVariableIdentifier . Name.name <$> source)
|
||||
|
||||
unitConstructor :: Assignment Term
|
||||
unitConstructor = makeTerm <$> token UnitConstructor <*> pure Syntax.UnitConstructor
|
||||
|
||||
variableIdentifier :: Assignment Term
|
||||
variableIdentifier = makeTerm <$> symbol VariableIdentifier <*> (Syntax.VariableIdentifier . Name.name <$> source)
|
||||
|
||||
variableOperator :: Assignment Term
|
||||
variableOperator = makeTerm <$> symbol VariableOperator <*> children (Syntax.VariableOperator <$> expression)
|
||||
|
||||
variableSymbol :: Assignment Term
|
||||
variableSymbol = makeTerm <$> (symbol VariableSymbol <|> symbol VariableSymbol') <*> (Syntax.VariableSymbol . Name.name <$> source)
|
||||
|
||||
variableIdentifiers :: Assignment Term
|
||||
variableIdentifiers = makeTerm <$> location <*> many variableIdentifier
|
||||
|
||||
viewPattern :: Assignment Term
|
||||
viewPattern = makeTerm <$> symbol ViewPattern <*> children (Syntax.ViewPattern <$> expression <*> expression)
|
||||
|
||||
where' :: Assignment Term
|
||||
where' = makeTerm <$> (symbol Where <|> symbol Where') <*> children (manyTerm expression)
|
||||
|
||||
wildcard :: Assignment Term
|
||||
wildcard = makeTerm <$> token Wildcard <*> pure Syntax.Wildcard
|
||||
|
||||
-- | Helpers
|
||||
|
||||
commentedTerm :: Assignment Term -> Assignment Term
|
||||
commentedTerm term = contextualize (comment <|> pragma) term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> pragma) <*> emptyTerm)
|
||||
|
||||
manyTerm :: Assignment Term -> Assignment [Term]
|
||||
manyTerm = many . commentedTerm
|
||||
|
||||
manyTermsTill :: Assignment Term -> Assignment b -> Assignment [Term]
|
||||
manyTermsTill step = manyTill (step <|> comment)
|
||||
|
||||
someTerm' :: Assignment Term -> Assignment (NonEmpty Term)
|
||||
someTerm' = NonEmpty.some1 . commentedTerm
|
||||
|
||||
term :: Assignment Term -> Assignment Term
|
||||
term term = contextualize (comment <|> pragma) (postContextualize (comment <|> pragma) term)
|
||||
@ -1,8 +0,0 @@
|
||||
module Language.Haskell.Syntax (module X) where
|
||||
|
||||
import Language.Haskell.Syntax.Constructor as X
|
||||
import Language.Haskell.Syntax.Haskell as X
|
||||
import Language.Haskell.Syntax.Identifier as X
|
||||
import Language.Haskell.Syntax.Pattern as X
|
||||
import Language.Haskell.Syntax.QuasiQuote as X
|
||||
import Language.Haskell.Syntax.Type as X
|
||||
@ -1,82 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
|
||||
module Language.Haskell.Syntax.Constructor where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.JSON.Fields
|
||||
import Diffing.Algorithm
|
||||
|
||||
data UnitConstructor a = UnitConstructor
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically UnitConstructor
|
||||
|
||||
instance Evaluatable UnitConstructor
|
||||
|
||||
newtype TupleConstructor a = TupleConstructor { tupleConstructorArity :: Int }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TupleConstructor
|
||||
|
||||
instance Evaluatable TupleConstructor
|
||||
|
||||
data ListConstructor a = ListConstructor
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ListConstructor
|
||||
|
||||
instance Evaluatable ListConstructor
|
||||
|
||||
data FunctionConstructor a = FunctionConstructor
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FunctionConstructor
|
||||
|
||||
instance Evaluatable FunctionConstructor
|
||||
|
||||
data RecordDataConstructor a = RecordDataConstructor { recordDataConstructorContext :: [a], recordDataConstructorName :: !a, recordDataConstructorFields :: !a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically RecordDataConstructor
|
||||
|
||||
instance Evaluatable RecordDataConstructor
|
||||
|
||||
newtype TypeConstructorExport a = TypeConstructorExport { typeConstructorExportContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeConstructorExport
|
||||
|
||||
instance Evaluatable TypeConstructorExport
|
||||
|
||||
data AllConstructors a = AllConstructors
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically AllConstructors
|
||||
|
||||
instance Evaluatable AllConstructors
|
||||
|
||||
newtype KindParenthesizedConstructor a = KindParenthesizedConstructor { kindParenthesizedConstructorContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically KindParenthesizedConstructor
|
||||
|
||||
instance Evaluatable KindParenthesizedConstructor
|
||||
|
||||
data GADTConstructor a = GADTConstructor { gadtConstructorContext :: a, gadtConstructorName :: a, gadtConstructorTypeSignature :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically GADTConstructor
|
||||
|
||||
instance Evaluatable GADTConstructor
|
||||
|
||||
newtype ConstructorSymbol a = ConstructorSymbol { constructorSymbolName :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ConstructorSymbol
|
||||
|
||||
instance Evaluatable ConstructorSymbol
|
||||
|
||||
data LabeledConstruction a = LabeledConstruction { labeledConstructionConstructor :: a, labeledConstructionFields :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically LabeledConstruction
|
||||
|
||||
instance Evaluatable LabeledConstruction
|
||||
|
||||
data InfixDataConstructor a = InfixDataConstructor { infixDataConstructorContext :: [a], infixDataConstructorLeft :: a, infixDataConstructorOperator :: a, infixDataConstructorRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically InfixDataConstructor
|
||||
|
||||
instance Evaluatable InfixDataConstructor
|
||||
@ -1,316 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
|
||||
module Language.Haskell.Syntax.Haskell where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.JSON.Fields
|
||||
import Diffing.Algorithm
|
||||
|
||||
data Module a = Module { moduleContext :: [a]
|
||||
, moduleIdentifier :: a
|
||||
, moduleExports :: [a]
|
||||
, moduleStatements :: a
|
||||
}
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Module
|
||||
|
||||
instance Evaluatable Module
|
||||
|
||||
data Field a = Field { fieldName :: !a, fieldBody :: !a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Field
|
||||
|
||||
instance Evaluatable Field
|
||||
|
||||
newtype Pragma a = Pragma { value :: Text }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Pragma
|
||||
|
||||
instance Evaluatable Pragma
|
||||
|
||||
newtype Deriving a = Deriving { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Deriving
|
||||
|
||||
instance Evaluatable Deriving
|
||||
|
||||
newtype ContextAlt a = ContextAlt { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ContextAlt
|
||||
|
||||
instance Evaluatable ContextAlt
|
||||
|
||||
newtype Class a = Class { classContent :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Class
|
||||
|
||||
instance Evaluatable Class
|
||||
|
||||
data GADT a = GADT { gadtContext :: a, gadtName :: a, gadtConstructors :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically GADT
|
||||
|
||||
instance Evaluatable GADT
|
||||
|
||||
newtype Export a = Export { exportContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Export
|
||||
|
||||
instance Evaluatable Export
|
||||
|
||||
newtype ModuleExport a = ModuleExport { moduleExportContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ModuleExport
|
||||
|
||||
instance Evaluatable ModuleExport
|
||||
|
||||
data InfixOperatorPattern a = InfixOperatorPattern { infixOperatorPatternLeft :: a, infixOperatorPatternOperator :: a, infixOperatorPatternRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically InfixOperatorPattern
|
||||
|
||||
instance Evaluatable InfixOperatorPattern
|
||||
|
||||
newtype QuotedName a = QuotedName { quotedNameContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuotedName
|
||||
|
||||
instance Evaluatable QuotedName
|
||||
|
||||
newtype ScopedTypeVariables a = ScopedTypeVariables { scopedTypeVariablesContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ScopedTypeVariables
|
||||
|
||||
instance Evaluatable ScopedTypeVariables
|
||||
|
||||
data NewType a = NewType { newTypeContext :: [a], newTypeLeft :: a, newTypeRight :: a, newTypeDeriving :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically NewType
|
||||
|
||||
instance Evaluatable NewType
|
||||
|
||||
newtype DefaultDeclaration a = DefaultDeclaration { defaultDeclarationContent :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically DefaultDeclaration
|
||||
|
||||
instance Evaluatable DefaultDeclaration
|
||||
|
||||
newtype VariableOperator a = VariableOperator { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically VariableOperator
|
||||
|
||||
instance Evaluatable VariableOperator
|
||||
|
||||
newtype ConstructorOperator a = ConstructorOperator { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ConstructorOperator
|
||||
|
||||
instance Evaluatable ConstructorOperator
|
||||
|
||||
newtype TypeOperator a = TypeOperator { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeOperator
|
||||
|
||||
instance Evaluatable TypeOperator
|
||||
|
||||
newtype PromotedTypeOperator a = PromotedTypeOperator { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically PromotedTypeOperator
|
||||
|
||||
instance Evaluatable PromotedTypeOperator
|
||||
|
||||
newtype VariableSymbol a = VariableSymbol { variableSymbolName :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically VariableSymbol
|
||||
|
||||
instance Evaluatable VariableSymbol
|
||||
|
||||
data ImportDeclaration a = ImportDeclaration { importPackageQualifiedContent :: a, importModule :: a, importSpec :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ImportDeclaration
|
||||
|
||||
instance Evaluatable ImportDeclaration
|
||||
|
||||
data QualifiedImportDeclaration a = QualifiedImportDeclaration { qualifiedImportPackageQualifiedContent :: a, qualifiedImportModule :: a, qualifiedImportSpec :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedImportDeclaration
|
||||
|
||||
instance Evaluatable QualifiedImportDeclaration
|
||||
|
||||
newtype Import a = Import { importContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Import
|
||||
|
||||
instance Evaluatable Import
|
||||
|
||||
newtype HiddenImport a = HiddenImport { hiddenimportContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically HiddenImport
|
||||
|
||||
instance Evaluatable HiddenImport
|
||||
|
||||
data ImportAlias a = ImportAlias { importAliasSource :: a, importAliasName :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ImportAlias
|
||||
|
||||
instance Evaluatable ImportAlias
|
||||
|
||||
data App a = App { appLeft :: a, appLeftTypeApp :: a, appRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically App
|
||||
|
||||
instance Evaluatable App
|
||||
|
||||
data InfixOperatorApp a = InfixOperatorApp { infixOperatorAppLeft :: a, infixOperatorAppLeftTypeApp :: a, infixOperatorAppOperator :: a, infixOperatorAppRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically InfixOperatorApp
|
||||
|
||||
instance Evaluatable InfixOperatorApp
|
||||
|
||||
newtype TypeApp a = TypeApp { typeAppType :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeApp
|
||||
|
||||
instance Evaluatable TypeApp
|
||||
|
||||
data ListComprehension a = ListComprehension { comprehensionValue :: a, comprehensionSource :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ListComprehension
|
||||
|
||||
instance Evaluatable ListComprehension
|
||||
|
||||
data Generator a = Generator { generatorValue :: a, generatorSource :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Generator
|
||||
|
||||
instance Evaluatable Generator
|
||||
|
||||
newtype TupleExpression a = TupleExpression { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TupleExpression
|
||||
|
||||
instance Evaluatable TupleExpression
|
||||
|
||||
newtype TuplePattern a = TuplePattern { value :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TuplePattern
|
||||
|
||||
instance Evaluatable TuplePattern
|
||||
|
||||
-- e.g. [1..], [1,2..], [1,2..10]
|
||||
data ArithmeticSequence a = ArithmeticSequence { from :: a, next :: Maybe a, to :: Maybe a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ArithmeticSequence
|
||||
|
||||
instance Evaluatable ArithmeticSequence
|
||||
|
||||
data RightOperatorSection a = RightOperatorSection { lhs :: a, rhs :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically RightOperatorSection
|
||||
|
||||
instance Evaluatable RightOperatorSection
|
||||
|
||||
data LeftOperatorSection a = LeftOperatorSection { lhs :: a, rhs :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically LeftOperatorSection
|
||||
|
||||
instance Evaluatable LeftOperatorSection
|
||||
|
||||
newtype ConstructorPattern a = ConstructorPattern { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ConstructorPattern
|
||||
|
||||
instance Evaluatable ConstructorPattern
|
||||
|
||||
-- e.g. `a <- b` in a Haskell do block.
|
||||
data BindPattern a = BindPattern { bindPatternLeft :: [a], bindPatternRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically BindPattern
|
||||
|
||||
instance Evaluatable BindPattern
|
||||
|
||||
newtype Do a = Do { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Do
|
||||
|
||||
instance Evaluatable Do
|
||||
|
||||
data Lambda a = Lambda { lambdaHead :: a, lambdaBody :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Lambda
|
||||
|
||||
instance Evaluatable Lambda
|
||||
|
||||
-- e.g. -1 or (-a) as an expression and not `-` as a variable operator.
|
||||
newtype PrefixNegation a = PrefixNegation { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically PrefixNegation
|
||||
|
||||
instance Evaluatable PrefixNegation
|
||||
|
||||
newtype CPPDirective a = CPPDirective { value :: Text }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically CPPDirective
|
||||
|
||||
instance Evaluatable CPPDirective
|
||||
|
||||
data FixityAlt a = FixityAlt { fixityPrecedence :: a, fixityIdentifier :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FixityAlt
|
||||
|
||||
instance Evaluatable FixityAlt
|
||||
|
||||
-- e.g. The `{..}` in `foo Bar{..} = baz`
|
||||
data RecordWildCards a = RecordWildCards
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically RecordWildCards
|
||||
|
||||
instance Evaluatable RecordWildCards
|
||||
|
||||
data Wildcard a = Wildcard
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Wildcard
|
||||
|
||||
instance Evaluatable Wildcard
|
||||
|
||||
data Let a = Let { letStatements :: [a], letInClause :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Let
|
||||
|
||||
instance Evaluatable Let
|
||||
|
||||
-- e.g. The `start` or `end` in `f Blob{start, end} = [start, end]`.
|
||||
newtype NamedFieldPun a = NamedFieldPun { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically NamedFieldPun
|
||||
|
||||
instance Evaluatable NamedFieldPun
|
||||
|
||||
-- e.g. The `-(1)` in `f (-(1)) = 1`.
|
||||
newtype NegativeLiteral a = NegativeLiteral { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically NegativeLiteral
|
||||
|
||||
instance Evaluatable NegativeLiteral
|
||||
|
||||
newtype LambdaCase a = LambdaCase { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically LambdaCase
|
||||
|
||||
instance Evaluatable LambdaCase
|
||||
|
||||
-- The `y { a = 1, b = 2} in `f y@Example = y { a = 1, b = 2 }`.
|
||||
newtype LabeledUpdate a = LabeledUpdate { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically LabeledUpdate
|
||||
|
||||
instance Evaluatable LabeledUpdate
|
||||
|
||||
-- The `a = 1` in `f y@Example = y { a = 1, b = 2 }`.
|
||||
data FieldBind a = FieldBind { fieldBindLeft :: a, fieldBindRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FieldBind
|
||||
|
||||
instance Evaluatable FieldBind
|
||||
@ -1,124 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
|
||||
module Language.Haskell.Syntax.Identifier where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.JSON.Fields
|
||||
import Diffing.Algorithm
|
||||
|
||||
newtype QualifiedTypeClassIdentifier a = QualifiedTypeClassIdentifier { values :: NonEmpty a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedTypeClassIdentifier
|
||||
|
||||
instance Hashable1 QualifiedTypeClassIdentifier where liftHashWithSalt = foldl
|
||||
|
||||
instance Evaluatable QualifiedTypeClassIdentifier
|
||||
|
||||
newtype QualifiedTypeConstructorIdentifier a = QualifiedTypeConstructorIdentifier { values :: NonEmpty a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedTypeConstructorIdentifier
|
||||
|
||||
instance Hashable1 QualifiedTypeConstructorIdentifier where liftHashWithSalt = foldl
|
||||
|
||||
instance Evaluatable QualifiedTypeConstructorIdentifier
|
||||
|
||||
newtype QualifiedConstructorIdentifier a = QualifiedConstructorIdentifier { values :: NonEmpty a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedConstructorIdentifier
|
||||
|
||||
instance Hashable1 QualifiedConstructorIdentifier where liftHashWithSalt = foldl
|
||||
|
||||
instance Evaluatable QualifiedConstructorIdentifier
|
||||
|
||||
newtype QualifiedInfixVariableIdentifier a = QualifiedInfixVariableIdentifier { values :: NonEmpty a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedInfixVariableIdentifier
|
||||
|
||||
instance Hashable1 QualifiedInfixVariableIdentifier where liftHashWithSalt = foldl
|
||||
|
||||
instance Evaluatable QualifiedInfixVariableIdentifier
|
||||
|
||||
newtype QualifiedModuleIdentifier a = QualifiedModuleIdentifier { values :: NonEmpty a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedModuleIdentifier
|
||||
|
||||
instance Hashable1 QualifiedModuleIdentifier where liftHashWithSalt = foldl
|
||||
|
||||
instance Evaluatable QualifiedModuleIdentifier
|
||||
|
||||
newtype QualifiedVariableIdentifier a = QualifiedVariableIdentifier { values :: NonEmpty a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QualifiedVariableIdentifier
|
||||
|
||||
instance Hashable1 QualifiedVariableIdentifier where liftHashWithSalt = foldl
|
||||
|
||||
instance Evaluatable QualifiedVariableIdentifier
|
||||
|
||||
newtype TypeVariableIdentifier a = TypeVariableIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeVariableIdentifier
|
||||
|
||||
instance Evaluatable TypeVariableIdentifier
|
||||
|
||||
newtype TypeConstructorIdentifier a = TypeConstructorIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeConstructorIdentifier
|
||||
|
||||
instance Evaluatable TypeConstructorIdentifier
|
||||
|
||||
newtype ModuleIdentifier a = ModuleIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ModuleIdentifier
|
||||
|
||||
instance Evaluatable ModuleIdentifier
|
||||
|
||||
newtype ConstructorIdentifier a = ConstructorIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ConstructorIdentifier
|
||||
|
||||
instance Evaluatable ConstructorIdentifier
|
||||
|
||||
newtype ImplicitParameterIdentifier a = ImplicitParameterIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ImplicitParameterIdentifier
|
||||
|
||||
instance Evaluatable ImplicitParameterIdentifier
|
||||
|
||||
newtype InfixConstructorIdentifier a = InfixConstructorIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically InfixConstructorIdentifier
|
||||
|
||||
instance Evaluatable InfixConstructorIdentifier
|
||||
|
||||
newtype InfixVariableIdentifier a = InfixVariableIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically InfixVariableIdentifier
|
||||
|
||||
instance Evaluatable InfixVariableIdentifier
|
||||
|
||||
newtype TypeClassIdentifier a = TypeClassIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeClassIdentifier
|
||||
|
||||
instance Evaluatable TypeClassIdentifier
|
||||
|
||||
newtype VariableIdentifier a = VariableIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically VariableIdentifier
|
||||
|
||||
instance Evaluatable VariableIdentifier
|
||||
|
||||
newtype PrimitiveConstructorIdentifier a = PrimitiveConstructorIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically PrimitiveConstructorIdentifier
|
||||
|
||||
instance Evaluatable PrimitiveConstructorIdentifier
|
||||
|
||||
newtype PrimitiveVariableIdentifier a = PrimitiveVariableIdentifier { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically PrimitiveVariableIdentifier
|
||||
|
||||
instance Evaluatable PrimitiveVariableIdentifier
|
||||
@ -1,89 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
|
||||
module Language.Haskell.Syntax.Pattern where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.JSON.Fields
|
||||
import Diffing.Algorithm
|
||||
|
||||
newtype StrictPattern a = StrictPattern { value :: a}
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically StrictPattern
|
||||
|
||||
instance Evaluatable StrictPattern
|
||||
|
||||
newtype ListPattern a = ListPattern { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ListPattern
|
||||
|
||||
instance Evaluatable ListPattern
|
||||
|
||||
-- e.g. The `n@num1` in `f n@num1 x@num2 = x`
|
||||
data AsPattern a = AsPattern { asPatternLeft :: a, asPatternRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically AsPattern
|
||||
|
||||
instance Evaluatable AsPattern
|
||||
|
||||
newtype TypePattern a = TypePattern { typePatternContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypePattern
|
||||
|
||||
instance Evaluatable TypePattern
|
||||
|
||||
-- e.g. The `a = 1` in `foo Bar{ a = 1 } = baz`.
|
||||
data FieldPattern a = FieldPattern { fieldPatternLeft :: a, fieldPatternRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FieldPattern
|
||||
|
||||
instance Evaluatable FieldPattern
|
||||
|
||||
-- e.g. The `~a` in `f ~a = 1`
|
||||
newtype IrrefutablePattern a = IrrefutablePattern { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically IrrefutablePattern
|
||||
|
||||
instance Evaluatable IrrefutablePattern
|
||||
|
||||
-- For handling guards in case alternative expressions.
|
||||
newtype CaseGuardPattern a = CaseGuardPattern { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically CaseGuardPattern
|
||||
|
||||
instance Evaluatable CaseGuardPattern
|
||||
|
||||
-- For handling guards in function declarations.
|
||||
newtype FunctionGuardPattern a = FunctionGuardPattern { values :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FunctionGuardPattern
|
||||
|
||||
instance Evaluatable FunctionGuardPattern
|
||||
|
||||
data ViewPattern a = ViewPattern { viewPatternLeft :: a, viewPatternRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ViewPattern
|
||||
|
||||
instance Evaluatable ViewPattern
|
||||
|
||||
-- e.g. The `Bar{..}` in `foo Bar{..} = baz`.
|
||||
newtype LabeledPattern a = LabeledPattern { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically LabeledPattern
|
||||
|
||||
instance Evaluatable LabeledPattern
|
||||
|
||||
-- The `a <- b` in `f a | a <- b = c` of a function declaration.
|
||||
data PatternGuard a = PatternGuard { patternGuardPattern :: a, patternGuardExpression :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically PatternGuard
|
||||
|
||||
instance Evaluatable PatternGuard
|
||||
|
||||
newtype Guard a = Guard { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Guard
|
||||
|
||||
instance Evaluatable Guard
|
||||
@ -1,58 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
|
||||
module Language.Haskell.Syntax.QuasiQuote where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.JSON.Fields
|
||||
import Diffing.Algorithm
|
||||
|
||||
data QuasiQuotation a = QuasiQuotation { quasiQuotationHead :: a, quasiQuotationBody :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotation
|
||||
|
||||
instance Evaluatable QuasiQuotation
|
||||
|
||||
newtype QuasiQuotationExpressionBody a = QuasiQuotationExpressionBody { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotationExpressionBody
|
||||
|
||||
instance Evaluatable QuasiQuotationExpressionBody
|
||||
|
||||
data QuasiQuotationPattern a = QuasiQuotationPattern
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotationPattern
|
||||
|
||||
instance Evaluatable QuasiQuotationPattern
|
||||
|
||||
data QuasiQuotationType a = QuasiQuotationType
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotationType
|
||||
|
||||
instance Evaluatable QuasiQuotationType
|
||||
|
||||
data QuasiQuotationDeclaration a = QuasiQuotationDeclaration
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotationDeclaration
|
||||
|
||||
instance Evaluatable QuasiQuotationDeclaration
|
||||
|
||||
newtype QuasiQuotationQuoter a = QuasiQuotationQuoter { name :: Name }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotationQuoter
|
||||
|
||||
instance Evaluatable QuasiQuotationQuoter
|
||||
|
||||
data QuasiQuotationExpression a = QuasiQuotationExpression
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically QuasiQuotationExpression
|
||||
|
||||
instance Evaluatable QuasiQuotationExpression
|
||||
|
||||
newtype Splice a = Splice { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Splice
|
||||
|
||||
instance Evaluatable Splice
|
||||
@ -1,150 +0,0 @@
|
||||
{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
|
||||
|
||||
module Language.Haskell.Syntax.Type where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.JSON.Fields
|
||||
import Diffing.Algorithm
|
||||
|
||||
data StrictType a = StrictType { strictTypeIdentifier :: a, strictTypeParameters :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically StrictType
|
||||
|
||||
instance Evaluatable StrictType
|
||||
|
||||
newtype StrictTypeVariable a = StrictTypeVariable { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically StrictTypeVariable
|
||||
|
||||
instance Evaluatable StrictTypeVariable
|
||||
|
||||
data Type a = Type { typeIdentifier :: a, typeParameters :: a, typeKindSignature :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Type
|
||||
|
||||
instance Evaluatable Type
|
||||
|
||||
data TypeSynonym a = TypeSynonym { typeSynonymLeft :: a, typeSynonymContext :: [a], typeSynonymRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeSynonym
|
||||
|
||||
instance Evaluatable TypeSynonym
|
||||
|
||||
data AnnotatedTypeVariable a = AnnotatedTypeVariable { annotatedTypeVariableIdentifier :: a, annotatedTypeVariableannotation :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically AnnotatedTypeVariable
|
||||
|
||||
instance Evaluatable AnnotatedTypeVariable
|
||||
|
||||
data StandaloneDerivingInstance a = StandaloneDerivingInstance { standaloneDerivingInstanceContext :: [a], standaloneDerivingInstanceClass :: a, standaloneDerivingInstanceInstance :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically StandaloneDerivingInstance
|
||||
|
||||
instance Evaluatable StandaloneDerivingInstance
|
||||
|
||||
data FunctionType a = FunctionType { functionTypeLeft :: a, functionTypeRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FunctionType
|
||||
|
||||
instance Evaluatable FunctionType
|
||||
|
||||
data TypeSignature a = TypeSignature { typeSignatureName :: [a], typeSignatureContext :: [a], typeSignatureContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeSignature
|
||||
|
||||
instance Evaluatable TypeSignature
|
||||
|
||||
data ExpressionTypeSignature a = ExpressionTypeSignature { expressionTypeSignatureName :: [a], expressionTypeSignatureContext :: [a], expressionTypeSignatureContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically ExpressionTypeSignature
|
||||
|
||||
instance Evaluatable ExpressionTypeSignature
|
||||
|
||||
newtype KindSignature a = KindSignature { kindSignatureContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically KindSignature
|
||||
|
||||
instance Evaluatable KindSignature
|
||||
|
||||
data KindFunctionType a = KindFunctionType { kindFunctionTypeLeft :: a, kindFunctionTypeRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically KindFunctionType
|
||||
|
||||
instance Evaluatable KindFunctionType
|
||||
|
||||
newtype Kind a = Kind { kindKind :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Kind
|
||||
|
||||
instance Evaluatable Kind
|
||||
|
||||
newtype KindListType a = KindListType { kindListTypeKind :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically KindListType
|
||||
|
||||
instance Evaluatable KindListType
|
||||
|
||||
data Star a = Star
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Star
|
||||
|
||||
instance Evaluatable Star
|
||||
|
||||
data EqualityConstraint a = EqualityConstraint { equalityConstraintLeft :: a, equalityConstraintRight :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically EqualityConstraint
|
||||
|
||||
instance Evaluatable EqualityConstraint
|
||||
|
||||
-- e.g. `type instance F [Int] = Int` where `F` is an open type family.
|
||||
data TypeInstance a = TypeInstance { typeInstanceType :: a, typeInstanceBody :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeInstance
|
||||
|
||||
instance Evaluatable TypeInstance
|
||||
|
||||
data TypeClassInstance a = TypeClassInstance { typeClassInstanceContext :: [a], typeClassInstanceIdentifier :: a, typeClassInstanceInstance :: a, typeClassInstanceBody :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeClassInstance
|
||||
|
||||
instance Evaluatable TypeClassInstance
|
||||
|
||||
newtype Instance a = Instance { value :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically Instance
|
||||
|
||||
instance Evaluatable Instance
|
||||
|
||||
newtype KindTupleType a = KindTupleType { kindTupleType :: [a] }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically KindTupleType
|
||||
|
||||
instance Evaluatable KindTupleType
|
||||
|
||||
data TypeClass a = TypeClass { typeClassContext :: a, typeClassIdentifier :: a, typeClassParameters :: [a], typeClassBody :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeClass
|
||||
|
||||
instance Evaluatable TypeClass
|
||||
|
||||
-- The default signature of a type class. The default signature has the same shape as a TypeSignature Assignment.
|
||||
data DefaultSignature a = DefaultSignature { defaultSignatureName :: [a], defaultSignatureContext :: [a], defaultSignatureContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically DefaultSignature
|
||||
|
||||
instance Evaluatable DefaultSignature
|
||||
|
||||
data TypeFamily a = TypeFamily { typeFamilyIdentifier :: a, typeFamilyParameters :: [a], typeFamilySignature :: a, typeFamilyBody :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically TypeFamily
|
||||
|
||||
instance Evaluatable TypeFamily
|
||||
|
||||
newtype FunctionalDependency a = FunctionalDependency { functionalDependencyContent :: a }
|
||||
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, NFData1)
|
||||
deriving (Eq1, Show1, Ord1) via Generically FunctionalDependency
|
||||
|
||||
instance Evaluatable FunctionalDependency
|
||||
@ -19,13 +19,11 @@ module Parsing.Parser
|
||||
, typescriptASTParser
|
||||
, phpParser
|
||||
, phpASTParser
|
||||
, haskellParser
|
||||
-- * Abstract parsers
|
||||
|
||||
-- $abstract
|
||||
, SomeParser(..)
|
||||
, goParser'
|
||||
, haskellParser'
|
||||
, javaParser'
|
||||
, javascriptParser'
|
||||
, jsonParser'
|
||||
@ -58,7 +56,6 @@ import qualified Data.Syntax as Syntax
|
||||
import Data.Term
|
||||
import Foreign.Ptr
|
||||
import qualified Language.Go.Assignment as Go
|
||||
import qualified Language.Haskell.Assignment as Haskell
|
||||
import qualified Language.Java as PreciseJava
|
||||
import qualified Language.JSON.Assignment as JSON
|
||||
import qualified Language.Markdown.Assignment as Markdown
|
||||
@ -71,7 +68,6 @@ import qualified Language.TypeScript.Assignment as TypeScript
|
||||
import Prelude hiding (fail)
|
||||
import Prologue
|
||||
import TreeSitter.Go
|
||||
import TreeSitter.Haskell
|
||||
import TreeSitter.Java
|
||||
import TreeSitter.JSON
|
||||
import qualified TreeSitter.Language as TS (Language, Symbol)
|
||||
@ -99,13 +95,11 @@ someAnalysisParser :: ( constraint (Sum Go.Syntax)
|
||||
, constraint (Sum Python.Syntax)
|
||||
, constraint (Sum Ruby.Syntax)
|
||||
, constraint (Sum TypeScript.Syntax)
|
||||
, constraint (Sum Haskell.Syntax)
|
||||
)
|
||||
=> proxy constraint -- ^ A proxy for the constraint required, e.g. @(Proxy \@Show1)@.
|
||||
-> Language -- ^ The 'Language' to select.
|
||||
-> SomeAnalysisParser constraint Loc -- ^ A 'SomeAnalysisParser' abstracting the syntax type to be produced.
|
||||
someAnalysisParser _ Go = SomeAnalysisParser goParser (Proxy @'Go)
|
||||
someAnalysisParser _ Haskell = SomeAnalysisParser haskellParser (Proxy @'Haskell)
|
||||
someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser (Proxy @'JavaScript)
|
||||
someAnalysisParser _ PHP = SomeAnalysisParser phpParser (Proxy @'PHP)
|
||||
someAnalysisParser _ Python = SomeAnalysisParser pythonParser (Proxy @'Python)
|
||||
@ -170,9 +164,6 @@ tsxParser = AssignmentParser (ASTParser tree_sitter_tsx) TSX.assignment
|
||||
typescriptASTParser :: Parser (AST [] TypeScript.Grammar)
|
||||
typescriptASTParser = ASTParser tree_sitter_typescript
|
||||
|
||||
haskellParser :: Parser Haskell.Term
|
||||
haskellParser = AssignmentParser (ASTParser tree_sitter_haskell) Haskell.assignment
|
||||
|
||||
markdownParser :: Parser Markdown.Term
|
||||
markdownParser = AssignmentParser MarkdownParser Markdown.assignment
|
||||
|
||||
@ -192,7 +183,6 @@ data SomeASTParser where
|
||||
|
||||
someASTParser :: Language -> Maybe SomeASTParser
|
||||
someASTParser Go = Just (SomeASTParser (ASTParser tree_sitter_go :: Parser (AST [] Go.Grammar)))
|
||||
someASTParser Haskell = Just (SomeASTParser (ASTParser tree_sitter_haskell :: Parser (AST [] Haskell.Grammar)))
|
||||
someASTParser JSON = Just (SomeASTParser (ASTParser tree_sitter_json :: Parser (AST [] JSON.Grammar)))
|
||||
|
||||
-- Use the TSX parser for `.js` and `.jsx` files in case they use Flow type-annotation syntax.
|
||||
@ -244,9 +234,6 @@ data SomeParser c a where
|
||||
goParser' :: c (Term (Sum Go.Syntax)) => (Language, SomeParser c Loc)
|
||||
goParser' = (Go, SomeParser goParser)
|
||||
|
||||
haskellParser' :: c (Term (Sum Haskell.Syntax)) => (Language, SomeParser c Loc)
|
||||
haskellParser' = (Haskell, SomeParser haskellParser)
|
||||
|
||||
javaParser' :: c PreciseJava.Term => (Language, SomeParser c Loc)
|
||||
javaParser' = (Python, SomeParser javaParserPrecise)
|
||||
|
||||
@ -289,7 +276,6 @@ typescriptParser' = (TypeScript, SomeParser typescriptParser)
|
||||
-- | The canonical set of parsers producing à la carte terms.
|
||||
aLaCarteParsers
|
||||
:: ( c (Term (Sum Go.Syntax))
|
||||
, c (Term (Sum Haskell.Syntax))
|
||||
, c (Term (Sum JSON.Syntax))
|
||||
, c (Term (Sum Markdown.Syntax))
|
||||
, c (Term (Sum PHP.Syntax))
|
||||
@ -301,7 +287,6 @@ aLaCarteParsers
|
||||
=> Map Language (SomeParser c Loc)
|
||||
aLaCarteParsers = Map.fromList
|
||||
[ goParser'
|
||||
, haskellParser'
|
||||
, javascriptParser'
|
||||
, jsonParser'
|
||||
, jsxParser'
|
||||
@ -327,7 +312,6 @@ preciseParsers = Map.fromList
|
||||
-- | The canonical set of all parsers for the passed per-language modes.
|
||||
allParsers
|
||||
:: ( c (Term (Sum Go.Syntax))
|
||||
, c (Term (Sum Haskell.Syntax))
|
||||
, c PreciseJava.Term
|
||||
, c (Term (Sum JSON.Syntax))
|
||||
, c (Term (Sum Markdown.Syntax))
|
||||
@ -342,7 +326,6 @@ allParsers
|
||||
-> Map Language (SomeParser c Loc)
|
||||
allParsers modes = Map.fromList
|
||||
[ goParser'
|
||||
, haskellParser'
|
||||
, javaParser'
|
||||
, javascriptParser'
|
||||
, jsonParser'
|
||||
|
||||
@ -15,23 +15,32 @@ module Semantic.Git
|
||||
, parseEntry
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Attoparsec.Text (Parser)
|
||||
import Data.Attoparsec.Text as AP
|
||||
import Data.Char
|
||||
import Data.Either (fromRight)
|
||||
import Data.Text as Text
|
||||
import Shelly hiding (FilePath)
|
||||
import Prologue
|
||||
|
||||
import Data.Attoparsec.Text (Parser)
|
||||
import Data.Attoparsec.Text as AP
|
||||
import qualified Data.ByteString.Streaming as ByteStream
|
||||
import Data.Char
|
||||
import Data.Either (fromRight)
|
||||
import Data.Text as Text
|
||||
import Shelly hiding (FilePath)
|
||||
import qualified Streaming.Process
|
||||
import qualified System.Process as Process (proc)
|
||||
import qualified Source.Source as Source
|
||||
|
||||
-- | git clone --bare
|
||||
clone :: Text -> FilePath -> IO ()
|
||||
clone url path = sh $ do
|
||||
run_ "git" ["clone", "--bare", url, pack path]
|
||||
|
||||
-- | git cat-file -p
|
||||
catFile :: FilePath -> OID -> IO Text
|
||||
catFile gitDir (OID oid) = sh $ do
|
||||
run "git" ["-C", pack gitDir, "cat-file", "-p", oid]
|
||||
-- | Runs @git cat-file -p@. Throws 'ProcessExitedUnsuccessfully' if the
|
||||
-- underlying git command returns a nonzero exit code. Loads the contents
|
||||
-- of the file into memory all at once and strictly.
|
||||
catFile :: FilePath -> OID -> IO Source.Source
|
||||
catFile gitDir (OID oid) =
|
||||
let process = Process.proc "git" ["-C", gitDir, "cat-file", "-p", Text.unpack oid]
|
||||
consumeStdout stream = Streaming.Process.withProcessOutput stream ByteStream.toStrict_
|
||||
in Source.fromUTF8 <$> Streaming.Process.withStreamProcess process consumeStdout
|
||||
|
||||
-- | git ls-tree -rz
|
||||
lsTree :: FilePath -> OID -> IO [TreeEntry]
|
||||
|
||||
@ -15,6 +15,7 @@ import Data.Blob
|
||||
import Data.Handle
|
||||
import qualified Semantic.Git as Git
|
||||
import Shelly (cd, run_, shelly, silently, touchfile, writefile)
|
||||
import qualified Source.Source as Source
|
||||
import SpecHelpers
|
||||
import System.Path ((</>))
|
||||
import qualified System.Path as Path
|
||||
@ -42,7 +43,7 @@ spec = do
|
||||
trees <- Git.lsTree (dir <> "/.git") (Git.OID "HEAD")
|
||||
Just it <- pure $ find (\p -> "日本語" `isInfixOf` Git.treeEntryPath p) trees
|
||||
Git.catFile (dir <> "/.git") (Git.treeEntryOid it)
|
||||
("日本語" `Text.isInfixOf` result) `shouldBe` True
|
||||
Source.toText result `shouldSatisfy` ("日本語" `Text.isInfixOf`)
|
||||
|
||||
describe "lsTree" $ do
|
||||
hasGit <- runIO $ isJust <$> findExecutable "git"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user