mirror of
https://github.com/github/semantic.git
synced 2024-12-26 08:25:19 +03:00
Merge pull request #439 from github/tower-of-babble
Remove Data.Blob.File in favor of Analysis.File and use semantic-source’s Language type.
This commit is contained in:
Rob Rix
GitHub
commit
2e9cd2c006
2
.github/workflows/haskell.yml
vendored
2
.github/workflows/haskell.yml
vendored
@ -37,7 +37,7 @@ jobs:
|
||||
name: Cache ~/.cabal/store
|
||||
with:
|
||||
path: ~/.cabal/store
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-v4-cabal-store
|
||||
key: ${{ runner.os }}-${{ matrix.ghc }}-v5-cabal-store
|
||||
|
||||
- uses: actions/cache@v1
|
||||
name: Cache dist-newstyle
|
||||
|
||||
@ -1,13 +1,17 @@
|
||||
{-# LANGUAGE DataKinds, FlexibleContexts, PackageImports, PartialTypeSignatures, TypeApplications, TypeFamilies #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Evaluation (benchmarks) where
|
||||
|
||||
import Control.Carrier.Parse.Simple
|
||||
import qualified Data.Duration as Duration
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Blob
|
||||
import Data.Blob.IO (readBlobFromFile')
|
||||
import Data.Bifunctor
|
||||
import Data.Blob.IO (readBlobFromPath)
|
||||
import qualified Data.Duration as Duration
|
||||
import "semantic" Data.Graph (topologicalSort)
|
||||
import qualified Data.Language as Language
|
||||
import Data.Project
|
||||
@ -18,21 +22,23 @@ import Semantic.Config (defaultOptions)
|
||||
import Semantic.Graph
|
||||
import Semantic.Task (TaskSession (..), runTask, withOptions)
|
||||
import Semantic.Util
|
||||
import qualified System.Path as Path
|
||||
import System.Path ((</>))
|
||||
import qualified System.Path as Path
|
||||
import qualified System.Path.PartClass as Path.PartClass
|
||||
|
||||
-- Duplicating this stuff from Util to shut off the logging
|
||||
|
||||
callGraphProject' :: ( Language.SLanguage lang
|
||||
, HasPrelude lang
|
||||
, Path.PartClass.AbsRel ar
|
||||
)
|
||||
=> TaskSession
|
||||
-> Proxy lang
|
||||
-> Path.RelFile
|
||||
-> Path.File ar
|
||||
-> IO (Either String ())
|
||||
callGraphProject' session proxy path
|
||||
| Just (SomeParser parser) <- parserForLanguage analysisParsers lang = fmap (bimap show (const ())) . runTask session $ do
|
||||
blob <- readBlobFromFile' (fileForTypedPath path)
|
||||
blob <- readBlobFromPath (Path.toAbsRel path)
|
||||
package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang []))
|
||||
modules <- topologicalSort <$> runImportGraphToModules proxy package
|
||||
runCallGraph proxy False modules package
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Tagging (benchmarks) where
|
||||
|
||||
@ -8,19 +8,19 @@ import Control.Carrier.Parse.Measured
|
||||
import Control.Carrier.Reader
|
||||
import Control.Exception (throwIO)
|
||||
import Control.Monad
|
||||
import Data.Blob
|
||||
import Data.Foldable
|
||||
import Data.Language (LanguageMode (..), PerLanguageModes (..))
|
||||
import Gauge
|
||||
import System.FilePath.Glob
|
||||
import qualified System.Path as Path
|
||||
|
||||
import Data.Flag
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Semantic.Api.Symbols (parseSymbols)
|
||||
import Semantic.Config as Config
|
||||
import Semantic.Task
|
||||
import Semantic.Task.Files
|
||||
import qualified Analysis.File as File
|
||||
import Data.Flag
|
||||
import Proto.Semantic as P hiding (Blob, BlobPair)
|
||||
import Semantic.Api.Symbols (parseSymbols)
|
||||
import Semantic.Config as Config
|
||||
import Semantic.Task
|
||||
import Semantic.Task.Files
|
||||
|
||||
benchmarks :: Benchmark
|
||||
benchmarks = bgroup "tagging"
|
||||
@ -66,7 +66,7 @@ parseSymbolsFilePath ::
|
||||
=> PerLanguageModes
|
||||
-> Path.RelFile
|
||||
-> m ParseTreeSymbolResponse
|
||||
parseSymbolsFilePath languageModes path = readBlob (fileForTypedPath path) >>= runReader languageModes . parseSymbols . pure @[]
|
||||
parseSymbolsFilePath languageModes path = readBlob (File.fromPath path) >>= runReader languageModes . parseSymbols . pure @[]
|
||||
|
||||
aLaCarteLanguageModes :: PerLanguageModes
|
||||
aLaCarteLanguageModes = PerLanguageModes
|
||||
|
||||
@ -56,17 +56,22 @@ library
|
||||
Analysis.Typecheck
|
||||
Control.Carrier.Fail.WithLoc
|
||||
build-depends:
|
||||
algebraic-graphs ^>= 0.3
|
||||
, aeson ^>= 1.4
|
||||
, algebraic-graphs ^>= 0.3
|
||||
, base >= 4.13 && < 5
|
||||
, containers ^>= 0.6
|
||||
, filepath
|
||||
, fused-effects ^>= 1.0
|
||||
, fused-effects-readline
|
||||
, fused-syntax
|
||||
, hashable
|
||||
, haskeline ^>= 0.7.5
|
||||
, lingo ^>= 0.3
|
||||
, pathtype ^>= 0.8.1
|
||||
, prettyprinter >= 1.2 && < 2
|
||||
, prettyprinter-ansi-terminal ^>= 1.1.1
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semilattices
|
||||
, terminal-size ^>= 0.3
|
||||
, text ^>= 1.2.3.1
|
||||
, transformers ^>= 0.5
|
||||
|
||||
@ -1,13 +1,18 @@
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
module Analysis.File
|
||||
( File(..)
|
||||
, fileLanguage
|
||||
, fromBody
|
||||
, fromPath
|
||||
) where
|
||||
|
||||
import Data.Maybe (fromJust, listToMaybe)
|
||||
import GHC.Stack
|
||||
import Source.Span
|
||||
import Data.Maybe (fromJust, listToMaybe)
|
||||
import Data.Semilattice.Lower
|
||||
import GHC.Stack
|
||||
import Source.Language as Language
|
||||
import Source.Span
|
||||
import qualified System.Path as Path
|
||||
import qualified System.Path.PartClass as Path.PartClass
|
||||
|
||||
data File a = File
|
||||
{ filePath :: !Path.AbsRelFile
|
||||
@ -19,3 +24,10 @@ data File a = File
|
||||
fromBody :: HasCallStack => a -> File a
|
||||
fromBody body = File (Path.absRel (srcLocFile srcLoc)) (spanFromSrcLoc srcLoc) body where
|
||||
srcLoc = snd (fromJust (listToMaybe (getCallStack callStack)))
|
||||
|
||||
-- | The language of the provided file, as inferred by 'Language.forPath'.
|
||||
fileLanguage :: File a -> Language
|
||||
fileLanguage = Language.forPath . filePath
|
||||
|
||||
fromPath :: Path.PartClass.AbsRel ar => Path.File ar -> File Language
|
||||
fromPath p = File (Path.toAbsRel p) lowerBound (Language.forPath p)
|
||||
|
||||
@ -19,9 +19,9 @@ import Data.ByteString.Lazy.Char8 (putStrLn)
|
||||
import Data.Aeson.Encode.Pretty (encodePretty)
|
||||
|
||||
data SemanticAST = SemanticAST
|
||||
{ format :: Format
|
||||
, noColor :: Bool
|
||||
, source :: Either [FilePath] String
|
||||
{ _format :: Format
|
||||
, _noColor :: Bool
|
||||
, _source :: Either [FilePath] String
|
||||
}
|
||||
|
||||
-- Usage: semantic-ast --format ARG [--no-color] (--sourceString STRING | FILEPATHS…)
|
||||
|
||||
@ -43,7 +43,7 @@ library
|
||||
-- other-extensions:
|
||||
build-depends: base ^>= 4.13
|
||||
, tree-sitter ^>= 0.8
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, tree-sitter-python ^>= 0.8.1
|
||||
, bytestring ^>= 0.10.8.2
|
||||
, optparse-applicative >= 0.14.3 && < 0.16
|
||||
|
||||
@ -1,27 +1,26 @@
|
||||
{-# LANGUAGE DefaultSignatures #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE DefaultSignatures #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Marshal.JSON
|
||||
( MarshalJSON(..)
|
||||
) where
|
||||
|
||||
import Data.Aeson as Aeson
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import GHC.Generics
|
||||
import Data.Text (Text)
|
||||
import Data.Aeson as Aeson
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import GHC.Generics
|
||||
|
||||
-- TODO: range and span will require a new release of semantic-source
|
||||
-- TODO: use toEncoding -- direct serialization to ByteString
|
||||
|
||||
-- Serialize unmarshaled ASTs into JSON representation by auto-deriving Aeson instances generically
|
||||
@ -33,7 +32,7 @@ class MarshalJSON t where
|
||||
fields acc = gfields acc . from1
|
||||
|
||||
-- Implement the sum case
|
||||
instance {-# OVERLAPPING #-} (MarshalJSON f, MarshalJSON g) => MarshalJSON (f :+: g) where
|
||||
instance {-# OVERLAPPING #-} (MarshalJSON f, MarshalJSON g) => MarshalJSON (f :+: g) where
|
||||
fields acc (L1 f) = fields acc f
|
||||
fields acc (R1 g) = fields acc g
|
||||
|
||||
@ -71,7 +70,7 @@ instance (MarshalJSON t) => GValue (Rec1 t) where
|
||||
|
||||
instance (GValue t) => GValue (Maybe :.: t) where
|
||||
gvalue (Comp1 (Just t)) = gvalue t
|
||||
gvalue (Comp1 Nothing) = Null
|
||||
gvalue (Comp1 Nothing) = Null
|
||||
|
||||
instance (GValue t) => GValue ([] :.: t) where
|
||||
gvalue (Comp1 ts) = toJSON $ map gvalue ts
|
||||
@ -85,4 +84,4 @@ class GFields f where
|
||||
|
||||
-- gvalue is a wrapper that calls to @toJSON@ (for leaf nodes such as @Text@) or recurses via @marshal@
|
||||
class GValue f where
|
||||
gvalue :: (ToJSON a) => f a -> Value
|
||||
gvalue :: (ToJSON a) => f a -> Value
|
||||
|
||||
@ -54,7 +54,7 @@ library
|
||||
, prettyprinter >= 1.2.1 && < 2
|
||||
, prettyprinter-ansi-terminal ^>= 1.1.1
|
||||
, semantic-analysis ^>= 0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, text ^>= 1.2.3.1
|
||||
, trifecta >= 2 && < 2.2
|
||||
, unordered-containers ^>= 0.2.10
|
||||
@ -69,7 +69,7 @@ test-suite test
|
||||
base
|
||||
, semantic-analysis
|
||||
, semantic-core
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source
|
||||
, fused-effects
|
||||
, fused-syntax
|
||||
, hedgehog ^>= 1
|
||||
|
||||
@ -25,7 +25,7 @@ common haskell
|
||||
, fused-syntax
|
||||
, parsers ^>= 0.12.10
|
||||
, semantic-core ^>= 0.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semantic-tags ^>= 0.0
|
||||
, text ^>= 1.2.3
|
||||
, tree-sitter ^>= 0.8
|
||||
|
||||
@ -25,7 +25,7 @@ library
|
||||
build-depends:
|
||||
base >= 4.13 && < 5
|
||||
, fused-effects ^>= 1.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semantic-tags ^>= 0.0
|
||||
, tree-sitter ^>= 0.8
|
||||
, tree-sitter-java ^>= 0.6.1
|
||||
|
||||
@ -25,7 +25,7 @@ common haskell
|
||||
, fused-syntax
|
||||
, parsers ^>= 0.12.10
|
||||
, semantic-core ^>= 0.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semantic-tags ^>= 0.0
|
||||
, semantic-scope-graph ^>= 0.0
|
||||
, semilattices ^>= 0
|
||||
|
||||
@ -25,7 +25,7 @@ common haskell
|
||||
, fused-syntax
|
||||
, parsers ^>= 0.12.10
|
||||
, semantic-core ^>= 0.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semantic-tags ^>= 0.0
|
||||
, text ^>= 1.2.3
|
||||
, tree-sitter ^>= 0.8
|
||||
|
||||
@ -38,7 +38,7 @@ library
|
||||
, semilattices
|
||||
, generic-monoid
|
||||
, pathtype
|
||||
, semantic-source ^>= 0.0
|
||||
, semantic-source ^>= 0.0.2
|
||||
, text ^>= 1.2.3.1
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
@ -26,7 +26,7 @@ library
|
||||
build-depends:
|
||||
base >= 4.13 && < 5
|
||||
, fused-effects ^>= 1.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, text ^>= 1.2.3.1
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
@ -25,7 +25,7 @@ common haskell
|
||||
, fused-syntax
|
||||
, parsers ^>= 0.12.10
|
||||
, semantic-core ^>= 0.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semantic-tags ^>= 0.0
|
||||
, text ^>= 1.2.3
|
||||
, tree-sitter ^>= 0.8
|
||||
|
||||
@ -25,7 +25,7 @@ common haskell
|
||||
, fused-syntax
|
||||
, parsers ^>= 0.12.10
|
||||
, semantic-core ^>= 0.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semantic-tags ^>= 0.0
|
||||
, text ^>= 1.2.3
|
||||
, tree-sitter ^>= 0.8
|
||||
|
||||
@ -67,7 +67,8 @@ common dependencies
|
||||
, recursion-schemes ^>= 5.1
|
||||
, scientific ^>= 0.3.6.2
|
||||
, safe-exceptions ^>= 0.1.7.0
|
||||
, semantic-source ^>= 0.0.1
|
||||
, semantic-analysis
|
||||
, semantic-source ^>= 0.0.2
|
||||
, semilattices ^>= 0.0.0.3
|
||||
, streaming ^>= 0.2.2.0
|
||||
, text ^>= 1.2.3.1
|
||||
|
||||
@ -6,18 +6,14 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Data.Blob
|
||||
( File(..)
|
||||
, fileForPath
|
||||
, fileForTypedPath
|
||||
, Blob(..)
|
||||
( Blob(..)
|
||||
, Blobs(..)
|
||||
, blobLanguage
|
||||
, NoLanguageForBlob (..)
|
||||
, blobPath
|
||||
, makeBlob
|
||||
, decodeBlobs
|
||||
, nullBlob
|
||||
, sourceBlob
|
||||
, fromSource
|
||||
, moduleForBlob
|
||||
, noLanguageForBlob
|
||||
, BlobPair
|
||||
@ -31,69 +27,51 @@ module Data.Blob
|
||||
|
||||
import Prologue
|
||||
|
||||
import Analysis.File (File (..))
|
||||
import Control.Effect.Error
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Edit
|
||||
import Data.JSON.Fields
|
||||
import Data.Language
|
||||
import Data.Module
|
||||
import Source.Source (Source)
|
||||
import Source.Language as Language
|
||||
import Source.Source (Source, totalSpan)
|
||||
import qualified Source.Source as Source
|
||||
import qualified System.FilePath as FP
|
||||
import qualified System.Path as Path
|
||||
import qualified System.Path.PartClass as Path.PartClass
|
||||
|
||||
-- | A 'FilePath' paired with its corresponding 'Language'.
|
||||
-- Unpacked to have the same size overhead as (FilePath, Language).
|
||||
data File = File
|
||||
{ filePath :: FilePath
|
||||
, fileLanguage :: Language
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | Prefer 'fileForTypedPath' if at all possible.
|
||||
fileForPath :: FilePath -> File
|
||||
fileForPath p = File p (languageForFilePath p)
|
||||
|
||||
fileForTypedPath :: Path.PartClass.AbsRel ar => Path.File ar -> File
|
||||
fileForTypedPath = fileForPath . Path.toString
|
||||
|
||||
-- | The source, path information, and language of a file read from disk.
|
||||
data Blob = Blob
|
||||
{ blobSource :: Source -- ^ The UTF-8 encoded source text of the blob.
|
||||
, blobFile :: File -- ^ Path/language information for this blob.
|
||||
, blobOid :: Text -- ^ Git OID for this blob, mempty if blob is not from a git db.
|
||||
{ blobSource :: Source -- ^ The UTF-8 encoded source text of the blob.
|
||||
, blobFile :: File Language -- ^ Path/language information for this blob.
|
||||
} deriving (Show, Eq)
|
||||
|
||||
blobLanguage :: Blob -> Language
|
||||
blobLanguage = fileLanguage . blobFile
|
||||
blobLanguage = Analysis.File.fileBody . blobFile
|
||||
|
||||
blobPath :: Blob -> FilePath
|
||||
blobPath = filePath . blobFile
|
||||
|
||||
makeBlob :: Source -> FilePath -> Language -> Text -> Blob
|
||||
makeBlob s p l = Blob s (File p l)
|
||||
{-# INLINE makeBlob #-}
|
||||
blobPath = Path.toString . Analysis.File.filePath . blobFile
|
||||
|
||||
newtype Blobs a = Blobs { blobs :: [a] }
|
||||
deriving (Generic, FromJSON)
|
||||
|
||||
instance FromJSON Blob where
|
||||
parseJSON = withObject "Blob" $ \b -> inferringLanguage
|
||||
<$> b .: "content"
|
||||
<*> b .: "path"
|
||||
<*> b .: "language"
|
||||
parseJSON = withObject "Blob" $ \b -> do
|
||||
src <- b .: "content"
|
||||
Right pth <- fmap Path.parse (b .: "path")
|
||||
lang <- b .: "language"
|
||||
let lang' = if knownLanguage lang then lang else Language.forPath pth
|
||||
pure (fromSource (pth :: Path.AbsRelFile) lang' src)
|
||||
|
||||
nullBlob :: Blob -> Bool
|
||||
nullBlob Blob{..} = Source.null blobSource
|
||||
|
||||
sourceBlob :: FilePath -> Language -> Source -> Blob
|
||||
sourceBlob filepath language source = makeBlob source filepath language mempty
|
||||
|
||||
inferringLanguage :: Source -> FilePath -> Language -> Blob
|
||||
inferringLanguage src pth lang
|
||||
| knownLanguage lang = makeBlob src pth lang mempty
|
||||
| otherwise = makeBlob src pth (languageForFilePath pth) mempty
|
||||
-- | Create a Blob from a provided path, language, and UTF-8 source.
|
||||
-- The resulting Blob's span is taken from the 'totalSpan' of the source.
|
||||
fromSource :: Path.PartClass.AbsRel ar => Path.File ar -> Language -> Source -> Blob
|
||||
fromSource filepath language source
|
||||
= Blob source (Analysis.File.File (Path.toAbsRel filepath) (totalSpan source) language)
|
||||
|
||||
decodeBlobs :: BL.ByteString -> Either String [Blob]
|
||||
decodeBlobs = fmap blobs <$> eitherDecode
|
||||
@ -112,7 +90,7 @@ moduleForBlob :: Maybe FilePath -- ^ The root directory relative to which the mo
|
||||
-> Module term -- ^ A 'Module' named appropriate for the 'Blob', holding the @term@, and constructed relative to the root 'FilePath', if any.
|
||||
moduleForBlob rootDir b = Module info
|
||||
where root = fromMaybe (FP.takeDirectory (blobPath b)) rootDir
|
||||
info = ModuleInfo (FP.makeRelative root (blobPath b)) (languageToText (blobLanguage b)) (blobOid b)
|
||||
info = ModuleInfo (FP.makeRelative root (blobPath b)) (languageToText (blobLanguage b)) mempty
|
||||
|
||||
-- | Represents a blobs suitable for diffing which can be either a blob to
|
||||
-- delete, a blob to insert, or a pair of blobs to diff.
|
||||
|
||||
@ -1,14 +1,17 @@
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
-- | These are primitive file IO methods for use in ghci and as internal functions.
|
||||
-- Instead of using these, consider if you can use the Files DSL instead.
|
||||
module Data.Blob.IO
|
||||
( readBlobFromFile
|
||||
, readBlobFromFile'
|
||||
, readBlobFromPath
|
||||
, readBlobsFromDir
|
||||
, readFilePair
|
||||
) where
|
||||
|
||||
import Prologue
|
||||
|
||||
import Analysis.File as File
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Data.Blob
|
||||
import qualified Data.ByteString as B
|
||||
@ -18,24 +21,29 @@ import qualified Source.Source as Source
|
||||
import qualified System.Path as Path
|
||||
|
||||
-- | Read a utf8-encoded file to a 'Blob'.
|
||||
readBlobFromFile :: MonadIO m => File -> m (Maybe Blob)
|
||||
readBlobFromFile (File "/dev/null" _) = pure Nothing
|
||||
readBlobFromFile (File path language) = do
|
||||
raw <- liftIO $ B.readFile path
|
||||
pure . Just . sourceBlob path language . Source.fromUTF8 $ raw
|
||||
readBlobFromFile :: MonadIO m => File Language -> m (Maybe Blob)
|
||||
readBlobFromFile (File (Path.toString -> "/dev/null") _ _) = pure Nothing
|
||||
readBlobFromFile file@(File path _ _language) = do
|
||||
raw <- liftIO $ B.readFile (Path.toString path)
|
||||
let newblob = Blob (Source.fromUTF8 raw) file
|
||||
pure . Just $ newblob
|
||||
|
||||
-- | Read a utf8-encoded file to a 'Blob', raising an IOError if it can't be found.
|
||||
readBlobFromFile' :: (MonadFail m, MonadIO m) => File -> m Blob
|
||||
-- | Read a utf8-encoded file to a 'Blob', failing if it can't be found.
|
||||
readBlobFromFile' :: (MonadFail m, MonadIO m) => File Language -> m Blob
|
||||
readBlobFromFile' file = do
|
||||
maybeFile <- readBlobFromFile file
|
||||
maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
|
||||
|
||||
-- | Read a blob from the provided absolute or relative path , failing if it can't be found.
|
||||
readBlobFromPath :: (MonadFail m, MonadIO m) => Path.AbsRelFile -> m Blob
|
||||
readBlobFromPath = readBlobFromFile' . File.fromPath
|
||||
|
||||
-- | Read all blobs in the directory with Language.supportedExts.
|
||||
readBlobsFromDir :: MonadIO m => Path.AbsRelDir -> m [Blob]
|
||||
readBlobsFromDir path = liftIO . fmap catMaybes $
|
||||
findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . fileForTypedPath)
|
||||
findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . File.fromPath)
|
||||
|
||||
readFilePair :: MonadIO m => File -> File -> m BlobPair
|
||||
readFilePair :: MonadIO m => File Language -> File Language -> m BlobPair
|
||||
readFilePair a b = do
|
||||
before <- readBlobFromFile a
|
||||
after <- readBlobFromFile b
|
||||
|
||||
@ -1,107 +1,19 @@
|
||||
{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase, OverloadedStrings #-}
|
||||
module Data.Language
|
||||
( Language (..)
|
||||
, SLanguage (..)
|
||||
, extensionsForLanguage
|
||||
, knownLanguage
|
||||
, languageForFilePath
|
||||
, pathIsMinified
|
||||
, supportedExts
|
||||
, codeNavLanguages
|
||||
, textToLanguage
|
||||
, languageToText
|
||||
( module Source.Language
|
||||
, LanguageMode(..)
|
||||
, PerLanguageModes(..)
|
||||
, defaultLanguageModes
|
||||
, LanguageMode(..)
|
||||
, codeNavLanguages
|
||||
, supportedExts
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import qualified Data.Languages as Lingo
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Prologue
|
||||
import System.FilePath.Posix
|
||||
import qualified Data.Text as T
|
||||
import Source.Language
|
||||
|
||||
-- | The various languages we support.
|
||||
-- Please do not reorder any of the field names: the current implementation of 'Primitive'
|
||||
-- delegates to the auto-generated 'Enum' instance.
|
||||
data Language
|
||||
= Unknown
|
||||
| Go
|
||||
| Haskell
|
||||
| Java
|
||||
| JavaScript
|
||||
| JSON
|
||||
| JSX
|
||||
| Markdown
|
||||
| Python
|
||||
| Ruby
|
||||
| TypeScript
|
||||
| PHP
|
||||
| TSX
|
||||
deriving (Eq, Generic, Ord, Read, Show, Bounded, Hashable, ToJSON, Enum)
|
||||
|
||||
class SLanguage (lang :: Language) where
|
||||
reflect :: proxy lang -> Language
|
||||
|
||||
instance SLanguage 'Unknown where
|
||||
reflect _ = Unknown
|
||||
|
||||
instance SLanguage 'Go where
|
||||
reflect _ = Go
|
||||
|
||||
instance SLanguage 'Haskell where
|
||||
reflect _ = Haskell
|
||||
|
||||
instance SLanguage 'Java where
|
||||
reflect _ = Java
|
||||
|
||||
instance SLanguage 'JavaScript where
|
||||
reflect _ = JavaScript
|
||||
|
||||
instance SLanguage 'JSON where
|
||||
reflect _ = JSON
|
||||
|
||||
instance SLanguage 'JSX where
|
||||
reflect _ = JSX
|
||||
|
||||
instance SLanguage 'Markdown where
|
||||
reflect _ = Markdown
|
||||
|
||||
instance SLanguage 'Python where
|
||||
reflect _ = Python
|
||||
|
||||
instance SLanguage 'Ruby where
|
||||
reflect _ = Ruby
|
||||
|
||||
instance SLanguage 'TypeScript where
|
||||
reflect _ = TypeScript
|
||||
|
||||
instance SLanguage 'PHP where
|
||||
reflect _ = PHP
|
||||
|
||||
instance FromJSON Language where
|
||||
parseJSON = withText "Language" $ \l ->
|
||||
pure $ textToLanguage l
|
||||
|
||||
-- | Predicate failing on 'Unknown' and passing in all other cases.
|
||||
knownLanguage :: Language -> Bool
|
||||
knownLanguage = (/= Unknown)
|
||||
|
||||
extensionsForLanguage :: Language -> [String]
|
||||
extensionsForLanguage language = T.unpack <$> maybe mempty Lingo.languageExtensions (Map.lookup (languageToText language) Lingo.languages)
|
||||
|
||||
-- | Return a language based on a FilePath's extension.
|
||||
languageForFilePath :: FilePath -> Language
|
||||
languageForFilePath path =
|
||||
let spurious lang = lang `elem` [ "Hack" -- .php files
|
||||
, "GCC Machine Description" -- .md files
|
||||
, "XML" -- .tsx files
|
||||
]
|
||||
allResults = Lingo.languageName <$> Lingo.languagesForPath path
|
||||
in case filter (not . spurious) allResults of
|
||||
[result] -> textToLanguage result
|
||||
_ -> Unknown
|
||||
codeNavLanguages :: [Language]
|
||||
codeNavLanguages = [Go, Java, Ruby, Python, JavaScript, TypeScript, PHP]
|
||||
|
||||
supportedExts :: [String]
|
||||
supportedExts = foldr append mempty supportedLanguages
|
||||
@ -111,53 +23,15 @@ supportedExts = foldr append mempty supportedLanguages
|
||||
supportedLanguages = fmap lookup (languageToText <$> codeNavLanguages)
|
||||
lookup k = Map.lookup k Lingo.languages
|
||||
|
||||
codeNavLanguages :: [Language]
|
||||
codeNavLanguages = [Go, Java, Ruby, Python, JavaScript, TypeScript, PHP]
|
||||
|
||||
pathIsMinified :: FilePath -> Bool
|
||||
pathIsMinified = isExtensionOf ".min.js"
|
||||
|
||||
languageToText :: Language -> T.Text
|
||||
languageToText = \case
|
||||
Unknown -> "Unknown"
|
||||
Go -> "Go"
|
||||
Haskell -> "Haskell"
|
||||
Java -> "Java"
|
||||
JavaScript -> "JavaScript"
|
||||
JSON -> "JSON"
|
||||
JSX -> "JSX"
|
||||
Markdown -> "Markdown"
|
||||
Python -> "Python"
|
||||
Ruby -> "Ruby"
|
||||
TypeScript -> "TypeScript"
|
||||
TSX -> "TSX"
|
||||
PHP -> "PHP"
|
||||
|
||||
textToLanguage :: T.Text -> Language
|
||||
textToLanguage = \case
|
||||
"Go" -> Go
|
||||
"Haskell" -> Haskell
|
||||
"Java" -> Java
|
||||
"JavaScript" -> JavaScript
|
||||
"JSON" -> JSON
|
||||
"JSX" -> JSX
|
||||
"Markdown" -> Markdown
|
||||
"Python" -> Python
|
||||
"Ruby" -> Ruby
|
||||
"TypeScript" -> TypeScript
|
||||
"TSX" -> TSX
|
||||
"PHP" -> PHP
|
||||
_ -> Unknown
|
||||
|
||||
|
||||
data PerLanguageModes = PerLanguageModes
|
||||
{ pythonMode :: LanguageMode
|
||||
, rubyMode :: LanguageMode
|
||||
, goMode :: LanguageMode
|
||||
{ pythonMode :: LanguageMode
|
||||
, rubyMode :: LanguageMode
|
||||
, goMode :: LanguageMode
|
||||
, typescriptMode :: LanguageMode
|
||||
, tsxMode :: LanguageMode
|
||||
, tsxMode :: LanguageMode
|
||||
, javascriptMode :: LanguageMode
|
||||
, jsxMode :: LanguageMode
|
||||
, jsxMode :: LanguageMode
|
||||
}
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
|
||||
@ -9,12 +9,13 @@ module Data.Project
|
||||
import Prelude hiding (readFile)
|
||||
import Prologue
|
||||
|
||||
import Analysis.File
|
||||
import Data.Blob
|
||||
import Data.Blob.IO
|
||||
import Data.Language
|
||||
import qualified Data.Text as T
|
||||
import System.FilePath.Posix
|
||||
import Semantic.IO
|
||||
import System.FilePath.Posix
|
||||
import qualified System.Path as Path
|
||||
|
||||
-- | A 'Project' contains all the information that semantic needs
|
||||
@ -32,7 +33,7 @@ projectName = T.pack . dropExtensions . takeFileName . projectRootDir
|
||||
projectExtensions :: Project -> [String]
|
||||
projectExtensions = extensionsForLanguage . projectLanguage
|
||||
|
||||
projectFiles :: Project -> [File]
|
||||
projectFiles :: Project -> [File Language]
|
||||
projectFiles = fmap blobFile . projectBlobs
|
||||
|
||||
readProjectFromPaths :: MonadIO m
|
||||
@ -56,5 +57,5 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
|
||||
blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths
|
||||
pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs)
|
||||
where
|
||||
toFile path = File (Path.toString path) lang
|
||||
toFile path = File path lowerBound lang
|
||||
exts = extensionsForLanguage lang
|
||||
|
||||
@ -1,21 +1,28 @@
|
||||
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, RecordWildCards #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Semantic.Api.Bridge
|
||||
( APIBridge (..)
|
||||
, APIConvert (..)
|
||||
, (#?)
|
||||
) where
|
||||
|
||||
import Analysis.File
|
||||
import Control.Lens
|
||||
import qualified Data.Blob as Data
|
||||
import qualified Data.Edit as Data
|
||||
import Data.Either
|
||||
import qualified Data.Language as Data
|
||||
import Data.ProtoLens (defMessage)
|
||||
import qualified Data.Text as T
|
||||
import qualified Semantic.Api.LegacyTypes as Legacy
|
||||
import Data.Text.Lens
|
||||
import qualified Proto.Semantic as API
|
||||
import Proto.Semantic_Fields as P
|
||||
import Source.Source (fromText, toText)
|
||||
import qualified Semantic.Api.LegacyTypes as Legacy
|
||||
import qualified Source.Source as Source (fromText, toText, totalSpan)
|
||||
import qualified Source.Span as Source
|
||||
import qualified System.Path as Path
|
||||
|
||||
-- | An @APIBridge x y@ instance describes an isomorphism between @x@ and @y@.
|
||||
-- This is suitable for types such as 'Pos' which are representationally equivalent
|
||||
@ -71,8 +78,18 @@ instance APIBridge T.Text Data.Language where
|
||||
|
||||
instance APIBridge API.Blob Data.Blob where
|
||||
bridging = iso apiBlobToBlob blobToApiBlob where
|
||||
blobToApiBlob b = defMessage & P.content .~ toText (Data.blobSource b) & P.path .~ T.pack (Data.blobPath b) & P.language .~ (bridging # Data.blobLanguage b)
|
||||
apiBlobToBlob blob = Data.makeBlob (fromText (blob^.content)) (T.unpack (blob^.path)) (blob^.(language . bridging)) mempty
|
||||
blobToApiBlob b
|
||||
= defMessage
|
||||
& P.content .~ Source.toText (Data.blobSource b)
|
||||
& P.path .~ T.pack (Data.blobPath b)
|
||||
& P.language .~ (bridging # Data.blobLanguage b)
|
||||
apiBlobToBlob blob =
|
||||
let src = blob^.content.to Source.fromText
|
||||
pth = fromRight (Path.toAbsRel Path.emptyFile) (blob^.path._Text.to Path.parse)
|
||||
in Data.Blob
|
||||
{ blobSource = src
|
||||
, blobFile = File pth (Source.totalSpan src) (blob^.language.bridging)
|
||||
}
|
||||
|
||||
|
||||
instance APIConvert API.BlobPair Data.BlobPair where
|
||||
|
||||
@ -1,4 +1,9 @@
|
||||
{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass, DuplicateRecordFields, OverloadedStrings, RecordWildCards #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
module Semantic.Api.LegacyTypes
|
||||
( DiffTreeRequest(..)
|
||||
, ParseTreeRequest(..)
|
||||
@ -10,7 +15,7 @@ module Semantic.Api.LegacyTypes
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Blob hiding (File(..))
|
||||
import Data.Blob
|
||||
import Prologue
|
||||
|
||||
newtype DiffTreeRequest = DiffTreeRequest { blobs :: [BlobPair] }
|
||||
@ -27,9 +32,9 @@ newtype ParseTreeSymbolResponse = ParseTreeSymbolResponse { files :: [File] }
|
||||
deriving (Eq, Show, Generic, ToJSON)
|
||||
|
||||
data File = File
|
||||
{ filePath :: Text
|
||||
{ filePath :: Text
|
||||
, fileLanguage :: Text
|
||||
, fileSymbols :: [Symbol]
|
||||
, fileSymbols :: [Symbol]
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
|
||||
@ -1,4 +1,14 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Semantic.Api.Symbols
|
||||
( legacyParseSymbols
|
||||
, parseSymbols
|
||||
@ -12,11 +22,11 @@ import Control.Effect.Reader
|
||||
import Control.Exception
|
||||
import Control.Lens
|
||||
import Data.Abstract.Declarations
|
||||
import Data.Blob hiding (File (..))
|
||||
import Data.Blob
|
||||
import Data.ByteString.Builder
|
||||
import Data.Language
|
||||
import Data.ProtoLens (defMessage)
|
||||
import Data.Term (IsTerm(..), TermF)
|
||||
import Data.Term (IsTerm (..), TermF)
|
||||
import Data.Text (pack)
|
||||
import qualified Parsing.Parser as Parser
|
||||
import Prologue
|
||||
@ -78,7 +88,6 @@ parseSymbols blobs = do
|
||||
& P.language .~ (bridging # blobLanguage')
|
||||
& P.symbols .~ mempty
|
||||
& P.errors .~ [defMessage & P.error .~ pack e]
|
||||
& P.blobOid .~ blobOid
|
||||
|
||||
tagsToFile :: [Tag] -> File
|
||||
tagsToFile tags = defMessage
|
||||
@ -86,7 +95,6 @@ parseSymbols blobs = do
|
||||
& P.language .~ (bridging # blobLanguage')
|
||||
& P.symbols .~ fmap tagToSymbol tags
|
||||
& P.errors .~ mempty
|
||||
& P.blobOid .~ blobOid
|
||||
|
||||
tagToSymbol :: Tag -> Symbol
|
||||
tagToSymbol Tag{..} = defMessage
|
||||
|
||||
@ -1,10 +1,12 @@
|
||||
{-# LANGUAGE ApplicativeDo, FlexibleContexts #-}
|
||||
{-# LANGUAGE ApplicativeDo #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
module Semantic.CLI (main) where
|
||||
|
||||
import qualified Analysis.File as File
|
||||
import qualified Control.Carrier.Parse.Measured as Parse
|
||||
import Control.Carrier.Reader
|
||||
import Data.Blob
|
||||
import Data.Blob.IO
|
||||
import Data.Either
|
||||
import qualified Data.Flag as Flag
|
||||
import Data.Handle
|
||||
import qualified Data.Language as Language
|
||||
@ -22,7 +24,6 @@ import qualified Semantic.Telemetry.Log as Log
|
||||
import Semantic.Version
|
||||
import Serializing.Format hiding (Options)
|
||||
import System.Exit (die)
|
||||
import System.FilePath
|
||||
import qualified System.Path as Path
|
||||
import qualified System.Path.PartClass as Path.PartClass
|
||||
|
||||
@ -151,10 +152,11 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g
|
||||
<$> ( Just <$> some (strArgument (metavar "FILES..."))
|
||||
<|> flag' Nothing (long "stdin" <> help "Read a list of newline-separated paths to analyze from stdin."))
|
||||
makeReadProjectFromPathsTask maybePaths = do
|
||||
paths <- maybeM (liftIO (many getLine)) maybePaths
|
||||
blobs <- traverse readBlobFromFile' (fileForPath <$> paths)
|
||||
strPaths <- maybeM (liftIO (many getLine)) maybePaths
|
||||
let paths = rights (Path.parse <$> strPaths)
|
||||
blobs <- traverse readBlobFromPath paths
|
||||
case paths of
|
||||
(x:_) -> pure $! Project (takeDirectory x) blobs (Language.languageForFilePath x) mempty
|
||||
(x:_) -> pure $! Project (Path.toString (Path.takeDirectory x)) blobs (Language.forPath x) mempty
|
||||
_ -> pure $! Project "/" mempty Language.Unknown mempty
|
||||
|
||||
allLanguages = intercalate "|" . fmap show $ [Language.Go .. maxBound]
|
||||
@ -183,8 +185,8 @@ languageModes = Language.PerLanguageModes
|
||||
<> value Language.ALaCarte
|
||||
<> showDefault)
|
||||
|
||||
filePathReader :: ReadM File
|
||||
filePathReader = fileForPath <$> str
|
||||
filePathReader :: ReadM (File.File Language.Language)
|
||||
filePathReader = File.fromPath <$> path
|
||||
|
||||
path :: (Path.PartClass.FileDir fd) => ReadM (Path.AbsRel fd)
|
||||
path = eitherReader Path.parse
|
||||
|
||||
@ -43,6 +43,7 @@ import Prelude hiding (readFile)
|
||||
import Analysis.Abstract.Caching.FlowInsensitive
|
||||
import Analysis.Abstract.Collecting
|
||||
import Analysis.Abstract.Graph as Graph
|
||||
import Analysis.File
|
||||
import Control.Abstract hiding (String)
|
||||
import Control.Abstract.PythonPackage as PythonPackage
|
||||
import Control.Algebra
|
||||
@ -68,7 +69,7 @@ import Data.Blob
|
||||
import Data.Graph
|
||||
import Data.Graph.ControlFlowVertex (VertexDeclaration)
|
||||
import Data.Language as Language
|
||||
import Data.List (isPrefixOf, isSuffixOf)
|
||||
import Data.List (isPrefixOf)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Project
|
||||
import Data.Text (pack, unpack)
|
||||
@ -81,6 +82,7 @@ import Semantic.Task as Task
|
||||
import Source.Loc as Loc
|
||||
import Source.Span
|
||||
import System.FilePath.Posix (takeDirectory, (</>))
|
||||
import qualified System.Path as Path
|
||||
import Text.Show.Pretty (ppShow)
|
||||
|
||||
data GraphType = ImportGraph | CallGraph
|
||||
@ -334,8 +336,9 @@ parsePythonPackage parser project = do
|
||||
]
|
||||
PythonPackage.FindPackages excludeDirs -> do
|
||||
trace "In Graph.FindPackages"
|
||||
let initFiles = filter (("__init__.py" `isSuffixOf`) . filePath) (projectFiles project)
|
||||
let packageDirs = filter (`notElem` ((projectRootDir project </>) . unpack <$> excludeDirs)) (takeDirectory . filePath <$> initFiles)
|
||||
let initFiles = filter (isInit . filePath) (projectFiles project)
|
||||
isInit = (== Path.relFile "__init__.py") . Path.takeFileName
|
||||
packageDirs = filter (`notElem` ((projectRootDir project </>) . unpack <$> excludeDirs)) (takeDirectory . Path.toString . filePath <$> initFiles)
|
||||
packageFromProject project [ blob | dir <- packageDirs
|
||||
, blob <- projectBlobs project
|
||||
, dir `isPrefixOf` blobPath blob
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
{-# LANGUAGE DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Semantic.IO
|
||||
( isDirectory
|
||||
, findFilesInDir
|
||||
@ -7,7 +11,6 @@ module Semantic.IO
|
||||
import Prelude hiding (readFile)
|
||||
import Prologue
|
||||
|
||||
import Data.Language
|
||||
import System.Directory (doesDirectoryExist)
|
||||
import System.Directory.Tree (AnchoredDirTree (..))
|
||||
import qualified System.Directory.Tree as Tree
|
||||
@ -18,6 +21,9 @@ import qualified System.Path.PartClass as Path.PartClass
|
||||
isDirectory :: MonadIO m => FilePath -> m Bool
|
||||
isDirectory path = liftIO (doesDirectoryExist path)
|
||||
|
||||
pathIsMinified :: FilePath -> Bool
|
||||
pathIsMinified = isExtensionOf ".min.js"
|
||||
|
||||
-- Recursively find files in a directory.
|
||||
findFilesInDir :: (Path.PartClass.AbsRel ar, MonadIO m) => Path.Dir ar -> [String] -> [Path.Dir ar] -> m [Path.File ar]
|
||||
findFilesInDir path exts excludeDirs = do
|
||||
|
||||
@ -1,4 +1,16 @@
|
||||
{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Semantic.Resolution
|
||||
( Resolution (..)
|
||||
, nodeJSResolutionMap
|
||||
@ -7,6 +19,7 @@ module Semantic.Resolution
|
||||
, ResolutionC(..)
|
||||
) where
|
||||
|
||||
import Analysis.File as File
|
||||
import Control.Algebra
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (parseMaybe)
|
||||
@ -21,10 +34,10 @@ import System.FilePath.Posix
|
||||
import qualified System.Path as Path
|
||||
|
||||
|
||||
nodeJSResolutionMap :: (Has Files sig m, MonadIO m) => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
|
||||
nodeJSResolutionMap :: Has Files sig m => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
|
||||
nodeJSResolutionMap rootDir prop excludeDirs = do
|
||||
files <- findFiles (Path.absRel rootDir) [".json"] (fmap Path.absRel excludeDirs)
|
||||
let packageFiles = fileForTypedPath <$> filter ((==) (Path.relFile "package.json") . Path.takeFileName) files
|
||||
let packageFiles = File.fromPath <$> filter ((==) (Path.relFile "package.json") . Path.takeFileName) files
|
||||
blobs <- readBlobs (FilesFromPaths packageFiles)
|
||||
pure $ fold (mapMaybe (lookup prop) blobs)
|
||||
where
|
||||
|
||||
@ -1,6 +1,15 @@
|
||||
{-# LANGUAGE DataKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs,
|
||||
GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeOperators,
|
||||
UndecidableInstances #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Semantic.Task.Files
|
||||
( Files
|
||||
@ -18,6 +27,7 @@ module Semantic.Task.Files
|
||||
, FilesArg(..)
|
||||
) where
|
||||
|
||||
import Analysis.File
|
||||
import Control.Algebra
|
||||
import Control.Effect.Error
|
||||
import Data.Blob
|
||||
@ -34,10 +44,10 @@ import qualified System.Path as Path
|
||||
import qualified System.Path.IO as IO (withBinaryFile)
|
||||
|
||||
data Source blob where
|
||||
FromPath :: File -> Source Blob
|
||||
FromPath :: File Language -> Source Blob
|
||||
FromHandle :: Handle 'IO.ReadMode -> Source [Blob]
|
||||
FromDir :: Path.AbsRelDir -> Source [Blob]
|
||||
FromPathPair :: File -> File -> Source BlobPair
|
||||
FromPathPair :: File Language -> File Language -> Source BlobPair
|
||||
FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
|
||||
|
||||
data Destination = ToPath Path.AbsRelFile | ToHandle (Handle 'IO.WriteMode)
|
||||
@ -83,26 +93,21 @@ instance (Has (Error SomeException) sig m, MonadFail m, MonadIO m) => Algebra (F
|
||||
Write (ToPath path) builder k -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder)) >> k
|
||||
Write (ToHandle (WriteHandle handle)) builder k -> liftIO (B.hPutBuilder handle builder) >> k
|
||||
|
||||
readBlob :: Has Files sig m => File -> m Blob
|
||||
readBlob :: Has Files sig m => File Language -> m Blob
|
||||
readBlob file = send (Read (FromPath file) pure)
|
||||
|
||||
-- Various ways to read in files
|
||||
data FilesArg
|
||||
= FilesFromHandle (Handle 'IO.ReadMode)
|
||||
| FilesFromPaths [File]
|
||||
| FilesFromPaths [File Language]
|
||||
|
||||
-- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
|
||||
readBlobs :: (Has Files sig m, MonadIO m) => FilesArg -> m [Blob]
|
||||
readBlobs :: Has Files sig m => FilesArg -> m [Blob]
|
||||
readBlobs (FilesFromHandle handle) = send (Read (FromHandle handle) pure)
|
||||
readBlobs (FilesFromPaths [path]) = do
|
||||
isDir <- isDirectory (filePath path)
|
||||
if isDir
|
||||
then send (Read (FromDir (Path.path (filePath path))) pure)
|
||||
else pure <$> send (Read (FromPath path) pure)
|
||||
readBlobs (FilesFromPaths paths) = traverse (send . flip Read pure . FromPath) paths
|
||||
readBlobs (FilesFromPaths paths) = traverse (send . flip Read pure . FromPath) paths
|
||||
|
||||
-- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
|
||||
readBlobPairs :: Has Files sig m => Either (Handle 'IO.ReadMode) [(File, File)] -> m [BlobPair]
|
||||
readBlobPairs :: Has Files sig m => Either (Handle 'IO.ReadMode) [(File Language, File Language)] -> m [BlobPair]
|
||||
readBlobPairs (Left handle) = send (Read (FromPairHandle handle) pure)
|
||||
readBlobPairs (Right paths) = traverse (send . flip Read pure . uncurry FromPathPair) paths
|
||||
|
||||
|
||||
@ -1,4 +1,10 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeOperators #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-}
|
||||
module Semantic.Util
|
||||
( evaluateProject'
|
||||
@ -11,14 +17,15 @@ module Semantic.Util
|
||||
|
||||
import Prelude hiding (readFile)
|
||||
|
||||
import Analysis.File
|
||||
import Control.Abstract
|
||||
import Control.Carrier.Fresh.Strict
|
||||
import Control.Carrier.Parse.Simple
|
||||
import Control.Carrier.Lift
|
||||
import Control.Carrier.Trace.Printing
|
||||
import Control.Carrier.Parse.Simple
|
||||
import Control.Carrier.Reader
|
||||
import Control.Carrier.Resumable.Either (SomeError (..))
|
||||
import Control.Carrier.State.Strict
|
||||
import Control.Carrier.Trace.Printing
|
||||
import Control.Lens.Getter
|
||||
import Data.Abstract.Address.Precise as Precise
|
||||
import Data.Abstract.Evaluatable
|
||||
@ -26,7 +33,6 @@ import Data.Abstract.Module
|
||||
import qualified Data.Abstract.ModuleTable as ModuleTable
|
||||
import Data.Abstract.Package
|
||||
import Data.Abstract.Value.Concrete as Concrete
|
||||
import Data.Blob
|
||||
import Data.Blob.IO
|
||||
import Data.Graph (topologicalSort)
|
||||
import qualified Data.Language as Language
|
||||
@ -39,9 +45,10 @@ import Semantic.Analysis
|
||||
import Semantic.Config
|
||||
import Semantic.Graph
|
||||
import Semantic.Task
|
||||
import Source.Span (HasSpan(..))
|
||||
import Source.Span (HasSpan (..))
|
||||
import System.Exit (die)
|
||||
import System.FilePath.Posix (takeDirectory)
|
||||
import qualified System.Path as Path
|
||||
|
||||
justEvaluating :: Evaluator term Precise (Value term Precise) _ result
|
||||
-> IO ( Heap Precise Precise (Value term Precise),
|
||||
@ -69,7 +76,7 @@ justEvaluating
|
||||
evaluateProject' session proxy parser paths = do
|
||||
let lang = Language.reflect proxy
|
||||
res <- runTask session $ asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout $ do
|
||||
blobs <- catMaybes <$> traverse readBlobFromFile (flip File lang <$> paths)
|
||||
blobs <- catMaybes <$> traverse readBlobFromFile (fileForPath <$> paths)
|
||||
package <- fmap snd <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang [])
|
||||
modules <- topologicalSort <$> runImportGraphToModules proxy package
|
||||
trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
|
||||
@ -86,6 +93,9 @@ parseFile, parseFileQuiet :: Parser term -> FilePath -> IO term
|
||||
parseFile parser = runTask' . (parse parser <=< readBlob . fileForPath)
|
||||
parseFileQuiet parser = runTaskQuiet . (parse parser <=< readBlob . fileForPath)
|
||||
|
||||
fileForPath :: FilePath -> File Language.Language
|
||||
fileForPath (Path.absRel -> p) = File p lowerBound (Language.forPath p)
|
||||
|
||||
runTask', runTaskQuiet :: ParseC TaskC a -> IO a
|
||||
runTask' task = runTaskWithOptions debugOptions (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure
|
||||
runTaskQuiet task = runTaskWithOptions defaultOptions (asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task) >>= either (die . displayException) pure
|
||||
|
||||
@ -1,8 +1,9 @@
|
||||
module Data.Language.Spec (testTree) where
|
||||
|
||||
import Data.Language
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Data.Language as Language
|
||||
import qualified System.Path as Path
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
testTree :: TestTree
|
||||
testTree = testGroup "Data.Language"
|
||||
@ -13,7 +14,7 @@ testTree = testGroup "Data.Language"
|
||||
codeNavLanguages @=? [Go, Java, Ruby, Python, JavaScript, TypeScript, PHP]
|
||||
|
||||
, testCase "languageForFilePath works for languages with ambiguous lingo extensions" $ do
|
||||
languageForFilePath "foo.php" @=? PHP
|
||||
languageForFilePath "foo.md" @=? Markdown
|
||||
languageForFilePath "foo.tsx" @=? TSX
|
||||
Language.forPath (Path.relFile "foo.php") @=? PHP
|
||||
Language.forPath (Path.relFile "foo.md" ) @=? Markdown
|
||||
Language.forPath (Path.relFile "foo.tsx") @=? TSX
|
||||
]
|
||||
|
||||
@ -1,13 +1,14 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
{-# OPTIONS_GHC -O1 #-}
|
||||
{-# OPTIONS_GHC -Wno-unused-top-binds -Wno-unused-imports #-}
|
||||
module Main (main) where
|
||||
|
||||
import qualified Analysis.File as File
|
||||
import Control.Carrier.Parse.Measured
|
||||
import Control.Carrier.Reader
|
||||
import Control.Concurrent.Async (forConcurrently)
|
||||
@ -16,9 +17,9 @@ import Control.Lens
|
||||
import Control.Monad
|
||||
import Data.Blob
|
||||
import Data.Foldable
|
||||
import Data.Int
|
||||
import Data.Language (LanguageMode (..), PerLanguageModes (..))
|
||||
import Data.List
|
||||
import Data.Int
|
||||
import qualified Data.Text as Text
|
||||
import Data.Traversable
|
||||
import System.FilePath.Glob
|
||||
@ -174,7 +175,7 @@ buildExamples session lang tsDir = do
|
||||
assertOK msg = either (\e -> HUnit.assertFailure (msg <> " failed to parse" <> show e)) (refuteErrors msg)
|
||||
refuteErrors msg a = case toList (a^.files) of
|
||||
[x] | (e:_) <- toList (x^.errors) -> HUnit.assertFailure (msg <> " parse errors " <> show e)
|
||||
_ -> pure ()
|
||||
_ -> pure ()
|
||||
|
||||
assertMatch a b = case (a, b) of
|
||||
(Right a, Right b) -> case (toList (a^.files), toList (b^.files)) of
|
||||
@ -307,4 +308,4 @@ parseSymbolsFilePath ::
|
||||
=> PerLanguageModes
|
||||
-> Path.RelFile
|
||||
-> m ParseTreeSymbolResponse
|
||||
parseSymbolsFilePath languageModes path = readBlob (fileForTypedPath path) >>= runReader languageModes . parseSymbols . pure @[]
|
||||
parseSymbolsFilePath languageModes path = readBlob (File.fromPath path) >>= runReader languageModes . parseSymbols . pure @[]
|
||||
|
||||
@ -1,4 +1,8 @@
|
||||
{-# LANGUAGE DataKinds, GADTs, OverloadedStrings, PackageImports, TypeApplications #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Graphing.Calls.Spec ( spec ) where
|
||||
|
||||
@ -7,6 +11,7 @@ import SpecHelpers
|
||||
|
||||
import Algebra.Graph
|
||||
|
||||
import qualified Analysis.File as File
|
||||
import Control.Effect.Parse
|
||||
import "semantic" Data.Graph (Graph (..), topologicalSort)
|
||||
import Data.Graph.ControlFlowVertex
|
||||
@ -19,7 +24,7 @@ callGraphPythonProject path = runTaskOrDie $ do
|
||||
let proxy = Proxy @'Language.Python
|
||||
lang = Language.Python
|
||||
SomeParser parser <- pure . fromJust $! parserForLanguage analysisParsers Language.Python
|
||||
blob <- readBlobFromFile' (fileForTypedPath path)
|
||||
blob <- readBlobFromFile' (File.fromPath path)
|
||||
package <- fmap snd <$> parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang [])
|
||||
modules <- topologicalSort <$> runImportGraphToModules proxy package
|
||||
runCallGraph proxy False modules package
|
||||
|
||||
@ -1,21 +1,22 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
module Parsing.Spec (spec) where
|
||||
|
||||
import Data.Blob
|
||||
import Data.ByteString.Char8 (pack)
|
||||
import Data.Duration
|
||||
import Data.Either
|
||||
import Data.Language
|
||||
import Parsing.TreeSitter
|
||||
import Source.Source
|
||||
import SpecHelpers
|
||||
import TreeSitter.JSON (Grammar, tree_sitter_json)
|
||||
import Data.Blob
|
||||
import Data.ByteString.Char8 (pack)
|
||||
import Data.Duration
|
||||
import Data.Either
|
||||
import Data.Language
|
||||
import Parsing.TreeSitter
|
||||
import Source.Source
|
||||
import SpecHelpers
|
||||
import qualified System.Path as Path
|
||||
import TreeSitter.JSON (Grammar, tree_sitter_json)
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "parseToAST" $ do
|
||||
let source = toJSONSource [1 :: Int .. 10000]
|
||||
let largeBlob = sourceBlob "large.json" JSON source
|
||||
let largeBlob = fromSource (Path.relFile "large.json") JSON source
|
||||
|
||||
it "returns a result when the timeout does not expire" $ do
|
||||
let timeout = fromMicroseconds 0 -- Zero microseconds indicates no timeout
|
||||
|
||||
@ -1,14 +1,16 @@
|
||||
module Semantic.CLI.Spec (testTree) where
|
||||
|
||||
import Analysis.File
|
||||
import Control.Carrier.Parse.Simple
|
||||
import Control.Carrier.Reader
|
||||
import Data.ByteString.Builder
|
||||
import Data.Language
|
||||
import Semantic.Api hiding (Blob, BlobPair, File)
|
||||
import Semantic.Task
|
||||
import Serializing.Format
|
||||
import System.IO.Unsafe
|
||||
import qualified System.Path as Path
|
||||
import System.Path ((</>))
|
||||
import qualified System.Path as Path
|
||||
import qualified System.Path.Directory as Path
|
||||
|
||||
import SpecHelpers
|
||||
@ -34,7 +36,7 @@ renderDiff ref new = unsafePerformIO $ do
|
||||
else ["git", "diff", ref, new]
|
||||
{-# NOINLINE renderDiff #-}
|
||||
|
||||
testForDiffFixture :: (String, [BlobPair] -> ParseC TaskC Builder, [(File, File)], Path.RelFile) -> TestTree
|
||||
testForDiffFixture :: (String, [BlobPair] -> ParseC TaskC Builder, [(File Language, File Language)], Path.RelFile) -> TestTree
|
||||
testForDiffFixture (diffRenderer, runDiff, files, expected) =
|
||||
goldenVsStringDiff
|
||||
("diff fixture renders to " <> diffRenderer <> " " <> show files)
|
||||
@ -42,7 +44,7 @@ testForDiffFixture (diffRenderer, runDiff, files, expected) =
|
||||
(Path.toString expected)
|
||||
(fmap toLazyByteString . runTaskOrDie $ readBlobPairs (Right files) >>= runDiff)
|
||||
|
||||
testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File], Path.RelFile) -> TestTree
|
||||
testForParseFixture :: (String, [Blob] -> ParseC TaskC Builder, [File Language], Path.RelFile) -> TestTree
|
||||
testForParseFixture (format, runParse, files, expected) =
|
||||
goldenVsStringDiff
|
||||
("diff fixture renders to " <> format)
|
||||
@ -50,7 +52,7 @@ testForParseFixture (format, runParse, files, expected) =
|
||||
(Path.toString expected)
|
||||
(fmap toLazyByteString . runTaskOrDie $ readBlobs (FilesFromPaths files) >>= runParse)
|
||||
|
||||
parseFixtures :: [(String, [Blob] -> ParseC TaskC Builder, [File], Path.RelFile)]
|
||||
parseFixtures :: [(String, [Blob] -> ParseC TaskC Builder, [File Language], Path.RelFile)]
|
||||
parseFixtures =
|
||||
[ ("s-expression", run . parseTermBuilder TermSExpression, path, Path.relFile "test/fixtures/ruby/corpus/and-or.parseA.txt")
|
||||
, ("json", run . parseTermBuilder TermJSONTree, path, prefix </> Path.file "parse-tree.json")
|
||||
@ -59,18 +61,18 @@ parseFixtures =
|
||||
, ("symbols", run . parseSymbolsBuilder Serializing.Format.JSON, path'', prefix </> Path.file "parse-tree.symbols.json")
|
||||
, ("protobuf symbols", run . parseSymbolsBuilder Serializing.Format.Proto, path'', prefix </> Path.file "parse-tree.symbols.protobuf.bin")
|
||||
]
|
||||
where path = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby]
|
||||
path' = [File "test/fixtures/ruby/corpus/and-or.A.rb" Ruby, File "test/fixtures/ruby/corpus/and-or.B.rb" Ruby]
|
||||
path'' = [File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby]
|
||||
where path = [File (Path.absRel "test/fixtures/ruby/corpus/and-or.A.rb") lowerBound Ruby]
|
||||
path' = [File (Path.absRel "test/fixtures/ruby/corpus/and-or.A.rb") lowerBound Ruby, File (Path.absRel"test/fixtures/ruby/corpus/and-or.B.rb") lowerBound Ruby]
|
||||
path'' = [File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound Ruby]
|
||||
prefix = Path.relDir "test/fixtures/cli"
|
||||
run = runReader defaultLanguageModes
|
||||
|
||||
diffFixtures :: [(String, [BlobPair] -> ParseC TaskC Builder, [(File, File)], Path.RelFile)]
|
||||
diffFixtures :: [(String, [BlobPair] -> ParseC TaskC Builder, [(File Language, File Language)], Path.RelFile)]
|
||||
diffFixtures =
|
||||
[ ("json diff", parseDiffBuilder DiffJSONTree, pathMode, prefix </> Path.file "diff-tree.json")
|
||||
, ("s-expression diff", parseDiffBuilder DiffSExpression, pathMode, Path.relFile "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt")
|
||||
, ("toc summaries diff", runReader defaultLanguageModes . diffSummaryBuilder Serializing.Format.JSON, pathMode, prefix </> Path.file "diff-tree.toc.json")
|
||||
, ("protobuf diff", runReader defaultLanguageModes . diffSummaryBuilder Serializing.Format.Proto, pathMode, prefix </> Path.file "diff-tree.toc.protobuf.bin")
|
||||
]
|
||||
where pathMode = [(File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby, File "test/fixtures/ruby/corpus/method-declaration.B.rb" Ruby)]
|
||||
where pathMode = [(File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.A.rb") lowerBound Ruby, File (Path.absRel "test/fixtures/ruby/corpus/method-declaration.B.rb") lowerBound Ruby)]
|
||||
prefix = Path.relDir "test/fixtures/cli"
|
||||
|
||||
@ -4,23 +4,25 @@ module Semantic.IO.Spec (spec) where
|
||||
|
||||
import Prelude hiding (readFile)
|
||||
|
||||
import Data.Blob
|
||||
import Analysis.File as File
|
||||
import Data.Blob as Blob
|
||||
import Data.Handle
|
||||
import SpecHelpers
|
||||
import qualified System.Path as Path
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "readFile" $ do
|
||||
it "returns a blob for extant files" $ do
|
||||
Just blob <- readBlobFromFile (File "semantic.cabal" Unknown)
|
||||
Just blob <- readBlobFromFile (File (Path.absRel "semantic.cabal") lowerBound Unknown)
|
||||
blobPath blob `shouldBe` "semantic.cabal"
|
||||
|
||||
it "throws for absent files" $ do
|
||||
readBlobFromFile (File "this file should not exist" Unknown) `shouldThrow` anyIOException
|
||||
readBlobFromFile (File (Path.absRel "/dev/doesnotexist") lowerBound Unknown) `shouldThrow` anyIOException
|
||||
|
||||
describe "readBlobPairsFromHandle" $ do
|
||||
let a = sourceBlob "method.rb" Ruby "def foo; end"
|
||||
let b = sourceBlob "method.rb" Ruby "def bar(x); end"
|
||||
let a = Blob.fromSource (Path.relFile "method.rb") Ruby "def foo; end"
|
||||
let b = Blob.fromSource (Path.relFile "method.rb") Ruby "def bar(x); end"
|
||||
it "returns blobs for valid JSON encoded diff input" $ do
|
||||
blobs <- blobsFromFilePath "test/fixtures/cli/diff.json"
|
||||
blobs `shouldBe` [Compare a b]
|
||||
@ -45,7 +47,7 @@ spec = do
|
||||
it "returns blobs for unsupported language" $ do
|
||||
h <- openFileForReading "test/fixtures/cli/diff-unsupported-language.json"
|
||||
blobs <- readBlobPairsFromHandle h
|
||||
let b' = sourceBlob "test.kt" Unknown "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
|
||||
let b' = Blob.fromSource (Path.relFile "test.kt") Unknown "fun main(args: Array<String>) {\nprintln(\"hi\")\n}\n"
|
||||
blobs `shouldBe` [Insert b']
|
||||
|
||||
it "detects language based on filepath for empty language" $ do
|
||||
@ -68,7 +70,7 @@ spec = do
|
||||
it "returns blobs for valid JSON encoded parse input" $ do
|
||||
h <- openFileForReading "test/fixtures/cli/parse.json"
|
||||
blobs <- readBlobsFromHandle h
|
||||
let a = sourceBlob "method.rb" Ruby "def foo; end"
|
||||
let a = Blob.fromSource (Path.relFile "method.rb") Ruby "def foo; end"
|
||||
blobs `shouldBe` [a]
|
||||
|
||||
it "throws on blank input" $ do
|
||||
|
||||
@ -1,20 +1,23 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Semantic.Spec (spec) where
|
||||
|
||||
import Control.Carrier.Reader
|
||||
import Control.Exception (fromException)
|
||||
import SpecHelpers
|
||||
import Analysis.File
|
||||
import Control.Carrier.Reader
|
||||
import Control.Exception (fromException)
|
||||
import qualified Data.Blob as Blob
|
||||
import SpecHelpers
|
||||
import qualified System.Path as Path
|
||||
|
||||
import Semantic.Api hiding (Blob)
|
||||
|
||||
-- we need some lenses here, oof
|
||||
setBlobLanguage :: Language -> Blob -> Blob
|
||||
setBlobLanguage lang b = b { blobFile = (blobFile b) { fileLanguage = lang }}
|
||||
setBlobLanguage lang b = b { blobFile = (blobFile b) { fileBody = lang }}
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "parseBlob" $ do
|
||||
let methodsBlob = makeBlob "def foo\nend\n" "methods.rb" Ruby mempty
|
||||
let methodsBlob = Blob.fromSource (Path.relFile "methods.rb") Ruby "def foo\nend\n"
|
||||
|
||||
it "returns error if given an unknown language (json)" $ do
|
||||
output <- fmap runBuilder . runTaskOrDie . runReader defaultLanguageModes $ parseTermBuilder TermJSONTree [ setBlobLanguage Unknown methodsBlob ]
|
||||
@ -23,8 +26,8 @@ spec = do
|
||||
it "throws if given an unknown language for sexpression output" $ do
|
||||
res <- runTaskWithOptions defaultOptions (runReader defaultLanguageModes (runParseWithConfig (parseTermBuilder TermSExpression [setBlobLanguage Unknown methodsBlob])))
|
||||
case res of
|
||||
Left exc -> fromException exc `shouldBe` Just (NoLanguageForBlob "methods.rb")
|
||||
Right _bad -> fail "Expected parseTermBuilder to fail for an unknown language"
|
||||
Left exc -> fromException exc `shouldBe` Just (NoLanguageForBlob "methods.rb")
|
||||
Right _bad -> fail "Expected parseTermBuilder to fail for an unknown language"
|
||||
|
||||
it "renders with the specified renderer" $ do
|
||||
output <- fmap runBuilder . runTaskOrDie . runReader defaultLanguageModes $ parseTermBuilder TermSExpression [methodsBlob]
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE DataKinds, FlexibleContexts #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module SpecHelpers
|
||||
@ -23,63 +24,64 @@ module SpecHelpers
|
||||
, evaluateProject
|
||||
) where
|
||||
|
||||
import Control.Abstract
|
||||
import Control.Carrier.Fresh.Strict
|
||||
import Control.Carrier.Parse.Simple
|
||||
import Control.Carrier.Reader as X
|
||||
import qualified Analysis.File as File
|
||||
import Control.Abstract
|
||||
import Control.Carrier.Fresh.Strict
|
||||
import Control.Carrier.Lift
|
||||
import Control.Carrier.Parse.Simple
|
||||
import Control.Carrier.Reader as X
|
||||
import Control.Carrier.Resumable.Either
|
||||
import Control.Carrier.State.Strict
|
||||
import qualified Control.Carrier.Trace.Ignoring as Trace.Ignoring
|
||||
import Control.Carrier.Resumable.Either
|
||||
import Control.Carrier.Lift
|
||||
import Control.Carrier.State.Strict
|
||||
import Control.Exception (displayException)
|
||||
import Control.Monad as X
|
||||
import Data.Abstract.Address.Precise as X
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.FreeVariables as X
|
||||
import Control.Exception (displayException)
|
||||
import Control.Monad as X
|
||||
import Data.Abstract.Address.Precise as X
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.FreeVariables as X
|
||||
import qualified Data.Abstract.Heap as Heap
|
||||
import Data.Abstract.Module as X
|
||||
import Data.Abstract.ModuleTable as X hiding (lookup)
|
||||
import Data.Abstract.Name as X
|
||||
import Data.Abstract.Module as X
|
||||
import Data.Abstract.ModuleTable as X hiding (lookup)
|
||||
import Data.Abstract.Name as X
|
||||
import qualified Data.Abstract.ScopeGraph as ScopeGraph
|
||||
import Data.Abstract.Value.Concrete (Value(..), ValueError, runValueError)
|
||||
import Data.Blob as X
|
||||
import Data.Blob.IO as X
|
||||
import Data.ByteString as X (ByteString)
|
||||
import Data.ByteString.Builder (Builder, toLazyByteString)
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
import Data.Edit as X
|
||||
import Data.Foldable (toList)
|
||||
import Data.Functor.Listable as X
|
||||
import Data.Language as X hiding (Precise)
|
||||
import Data.List.NonEmpty as X (NonEmpty(..))
|
||||
import Data.Maybe as X
|
||||
import Data.Monoid as X (Monoid(..), First(..), Last(..))
|
||||
import Data.Project as X
|
||||
import Data.Proxy as X
|
||||
import Data.Semigroup as X (Semigroup(..))
|
||||
import Data.Semilattice.Lower as X
|
||||
import Data.String
|
||||
import Data.Sum as Sum
|
||||
import Data.Term as X
|
||||
import Data.Traversable as X (for)
|
||||
import Debug.Trace as X (traceShowM, traceM)
|
||||
import Parsing.Parser as X
|
||||
import Semantic.Api hiding (File, Blob, BlobPair)
|
||||
import Semantic.Config (Config(..), optionsLogLevel)
|
||||
import Semantic.Graph (analysisParsers, runHeap, runScopeGraph)
|
||||
import Semantic.Task as X
|
||||
import Semantic.Telemetry (LogQueue, StatQueue)
|
||||
import Semantic.Util as X
|
||||
import Source.Range as X hiding (start, end, point)
|
||||
import Source.Source as X (Source)
|
||||
import Source.Span as X hiding (HasSpan(..), start, end, point)
|
||||
import System.Exit (die)
|
||||
import Data.Abstract.Value.Concrete (Value (..), ValueError, runValueError)
|
||||
import Data.Blob as X
|
||||
import Data.Blob.IO as X
|
||||
import Data.ByteString as X (ByteString)
|
||||
import Data.ByteString.Builder (Builder, toLazyByteString)
|
||||
import Data.ByteString.Lazy (toStrict)
|
||||
import Data.Edit as X
|
||||
import Data.Foldable (toList)
|
||||
import Data.Functor.Listable as X
|
||||
import Data.Language as X hiding (Precise)
|
||||
import Data.List.NonEmpty as X (NonEmpty (..))
|
||||
import Data.Maybe as X
|
||||
import Data.Monoid as X (First (..), Last (..), Monoid (..))
|
||||
import Data.Project as X
|
||||
import Data.Proxy as X
|
||||
import Data.Semigroup as X (Semigroup (..))
|
||||
import Data.Semilattice.Lower as X
|
||||
import Data.String
|
||||
import Data.Sum as Sum
|
||||
import Data.Term as X
|
||||
import Data.Traversable as X (for)
|
||||
import Debug.Trace as X (traceM, traceShowM)
|
||||
import Parsing.Parser as X
|
||||
import Semantic.Api hiding (Blob, BlobPair, File)
|
||||
import Semantic.Config (Config (..), optionsLogLevel)
|
||||
import Semantic.Graph (analysisParsers, runHeap, runScopeGraph)
|
||||
import Semantic.Task as X
|
||||
import Semantic.Telemetry (LogQueue, StatQueue)
|
||||
import Semantic.Util as X
|
||||
import Source.Range as X hiding (end, point, start)
|
||||
import Source.Source as X (Source)
|
||||
import Source.Span as X hiding (HasSpan (..), end, point, start)
|
||||
import System.Exit (die)
|
||||
import qualified System.Path as Path
|
||||
import Test.Hspec as X (Spec, SpecWith, context, describe, it, xit, parallel, pendingWith, around, runIO)
|
||||
import Test.Hspec.Expectations as X
|
||||
import Test.Hspec.LeanCheck as X
|
||||
import Test.LeanCheck as X
|
||||
import Unsafe.Coerce (unsafeCoerce)
|
||||
import Test.Hspec as X (Spec, SpecWith, around, context, describe, it, parallel, pendingWith, runIO, xit)
|
||||
import Test.Hspec.Expectations as X
|
||||
import Test.Hspec.LeanCheck as X
|
||||
import Test.LeanCheck as X
|
||||
import Unsafe.Coerce (unsafeCoerce)
|
||||
|
||||
runBuilder :: Builder -> ByteString
|
||||
runBuilder = toStrict . toLazyByteString
|
||||
@ -99,7 +101,7 @@ diffFilePaths session p1 p2 = do
|
||||
-- | Returns an s-expression parse tree for the specified path.
|
||||
parseFilePath :: TaskSession -> Path.RelFile -> IO (Either SomeException ByteString)
|
||||
parseFilePath session path = do
|
||||
blob <- readBlobFromFile (fileForTypedPath path)
|
||||
blob <- readBlobFromFile (File.fromPath path)
|
||||
res <- runTask session . runParse (configTreeSitterParseTimeout (config session)) . runReader defaultLanguageModes $ parseTermBuilder TermSExpression (toList blob)
|
||||
pure (runBuilder <$> res)
|
||||
|
||||
@ -108,7 +110,7 @@ runParseWithConfig task = asks configTreeSitterParseTimeout >>= \ timeout -> run
|
||||
|
||||
-- | Read two files to a BlobPair.
|
||||
readFilePathPair :: Path.RelFile -> Path.RelFile -> IO BlobPair
|
||||
readFilePathPair p1 p2 = readFilePair (fileForTypedPath p1) (fileForTypedPath p2)
|
||||
readFilePathPair p1 p2 = readFilePair (File.fromPath p1) (File.fromPath p2)
|
||||
|
||||
-- Run a Task and call `die` if it returns an Exception.
|
||||
runTaskOrDie :: ParseC TaskC a -> IO a
|
||||
|
||||
@ -1,12 +1,13 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Tags.Spec (spec) where
|
||||
|
||||
import Control.Carrier.Reader
|
||||
import Semantic.Api.Symbols
|
||||
import Source.Loc
|
||||
import SpecHelpers
|
||||
import qualified Analysis.File as File
|
||||
import Control.Carrier.Reader
|
||||
import Semantic.Api.Symbols
|
||||
import Source.Loc
|
||||
import SpecHelpers
|
||||
import qualified System.Path as Path
|
||||
import Tags.Tagging as Tags
|
||||
import Tags.Tagging as Tags
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
@ -90,4 +91,4 @@ spec = do
|
||||
]
|
||||
|
||||
parseTestFile :: Foldable t => t Tags.Kind -> Path.RelFile -> IO [Tag]
|
||||
parseTestFile include path = runTaskOrDie $ readBlob (fileForPath (Path.toString path)) >>= runReader defaultLanguageModes . fmap (filter ((`elem` include) . kind)) . tagsForBlob
|
||||
parseTestFile include path = runTaskOrDie $ readBlob (File.fromPath path) >>= runReader defaultLanguageModes . fmap (filter ((`elem` include) . kind)) . tagsForBlob
|
||||
|
||||
Loading…
Reference in New Issue
Block a user