mirror of
https://github.com/github/semantic.git
synced 2024-12-29 18:06:14 +03:00
cleanup
This commit is contained in:
parent
c4897c57c6
commit
c4c92053de
@ -1,59 +0,0 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
|
||||||
module Analysis.IdentifierName
|
|
||||||
( IdentifierName(..)
|
|
||||||
, IdentifierLabel(..)
|
|
||||||
, identifierLabel
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Abstract.Name (unName)
|
|
||||||
import Data.Aeson
|
|
||||||
import Data.JSON.Fields
|
|
||||||
import Data.Sum
|
|
||||||
import qualified Data.Syntax
|
|
||||||
import Data.Term
|
|
||||||
import Prologue
|
|
||||||
|
|
||||||
-- | Compute a 'IdentifierLabel' label for a 'Term'.
|
|
||||||
identifierLabel :: IdentifierName syntax => TermF syntax a b -> Maybe IdentifierLabel
|
|
||||||
identifierLabel (In _ s) = IdentifierLabel <$> identifierName s
|
|
||||||
|
|
||||||
newtype IdentifierLabel = IdentifierLabel Text
|
|
||||||
deriving (Show)
|
|
||||||
|
|
||||||
instance ToJSONFields IdentifierLabel where
|
|
||||||
toJSONFields (IdentifierLabel s) = [ "name" .= s ]
|
|
||||||
|
|
||||||
|
|
||||||
-- | A typeclass to retrieve the name of syntax identifiers.
|
|
||||||
--
|
|
||||||
-- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap; see also src/Analysis/Declaration.hs for discussion of the details of the mechanism.
|
|
||||||
class IdentifierName syntax where
|
|
||||||
identifierName :: syntax a -> Maybe Text
|
|
||||||
|
|
||||||
instance (IdentifierNameStrategy syntax ~ strategy, IdentifierNameWithStrategy strategy syntax) => IdentifierName syntax where
|
|
||||||
identifierName = identifierNameWithStrategy (Proxy :: Proxy strategy)
|
|
||||||
|
|
||||||
class CustomIdentifierName syntax where
|
|
||||||
customIdentifierName :: syntax a -> Maybe Text
|
|
||||||
|
|
||||||
instance Apply IdentifierName fs => CustomIdentifierName (Sum fs) where
|
|
||||||
customIdentifierName = apply @IdentifierName identifierName
|
|
||||||
|
|
||||||
instance CustomIdentifierName Data.Syntax.Identifier where
|
|
||||||
customIdentifierName (Data.Syntax.Identifier name) = Just (unName name)
|
|
||||||
|
|
||||||
data Strategy = Default | Custom
|
|
||||||
|
|
||||||
type family IdentifierNameStrategy syntax where
|
|
||||||
IdentifierNameStrategy (Sum _) = 'Custom
|
|
||||||
IdentifierNameStrategy Data.Syntax.Identifier = 'Custom
|
|
||||||
IdentifierNameStrategy syntax = 'Default
|
|
||||||
|
|
||||||
class IdentifierNameWithStrategy (strategy :: Strategy) syntax where
|
|
||||||
identifierNameWithStrategy :: proxy strategy -> syntax a -> Maybe Text
|
|
||||||
|
|
||||||
instance IdentifierNameWithStrategy 'Default syntax where
|
|
||||||
identifierNameWithStrategy _ _ = Nothing
|
|
||||||
|
|
||||||
instance (CustomIdentifierName syntax) => IdentifierNameWithStrategy 'Custom syntax where
|
|
||||||
identifierNameWithStrategy _ = customIdentifierName
|
|
@ -167,6 +167,8 @@ symbol s = tracing (Choose (Table.singleton s location) Nothing Nothing) `Then`
|
|||||||
rawSource :: HasCallStack => Assignment ast grammar ByteString
|
rawSource :: HasCallStack => Assignment ast grammar ByteString
|
||||||
rawSource = tracing Source `Then` return
|
rawSource = tracing Source `Then` return
|
||||||
|
|
||||||
|
-- | A rule to produce a node's source as Text. Fails if the node's source
|
||||||
|
-- can't be parsed as UTF-8.
|
||||||
source :: HasCallStack => Assignment ast grammar Text
|
source :: HasCallStack => Assignment ast grammar Text
|
||||||
source = rawSource >>= \b -> case decodeUtf8' b of
|
source = rawSource >>= \b -> case decodeUtf8' b of
|
||||||
Right t -> pure t
|
Right t -> pure t
|
||||||
|
@ -1,7 +1,5 @@
|
|||||||
module Control.Abstract.Primitive where
|
module Control.Abstract.Primitive where
|
||||||
|
|
||||||
import Prologue
|
|
||||||
|
|
||||||
import Control.Abstract.Addressable
|
import Control.Abstract.Addressable
|
||||||
import Control.Abstract.Context
|
import Control.Abstract.Context
|
||||||
import Control.Abstract.Environment
|
import Control.Abstract.Environment
|
||||||
@ -11,7 +9,8 @@ import Control.Abstract.Value
|
|||||||
import Data.Abstract.Name
|
import Data.Abstract.Name
|
||||||
import Data.Semigroup.Reducer hiding (unit)
|
import Data.Semigroup.Reducer hiding (unit)
|
||||||
import Data.Semilattice.Lower
|
import Data.Semilattice.Lower
|
||||||
import qualified Data.Text as T
|
import Data.Text (pack, unpack)
|
||||||
|
import Prologue
|
||||||
|
|
||||||
builtin :: ( HasCallStack
|
builtin :: ( HasCallStack
|
||||||
, Member (Allocator address value) effects
|
, Member (Allocator address value) effects
|
||||||
|
@ -41,7 +41,7 @@ resolveGoImport (ImportPath path Relative) = do
|
|||||||
paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path)
|
paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path)
|
||||||
case paths of
|
case paths of
|
||||||
[] -> throwResumable $ GoImportError path
|
[] -> throwResumable $ GoImportError path
|
||||||
_ -> pure paths
|
_ -> pure paths
|
||||||
resolveGoImport (ImportPath path NonRelative) = do
|
resolveGoImport (ImportPath path NonRelative) = do
|
||||||
package <- T.unpack . unName . Package.packageName <$> currentPackage
|
package <- T.unpack . unName . Package.packageName <$> currentPackage
|
||||||
trace ("attempting to resolve " <> show path <> " for package " <> package)
|
trace ("attempting to resolve " <> show path <> " for package " <> package)
|
||||||
@ -50,7 +50,7 @@ resolveGoImport (ImportPath path NonRelative) = do
|
|||||||
-- First two are source, next is package name, remaining are path to package
|
-- First two are source, next is package name, remaining are path to package
|
||||||
-- (e.g. github.com/golang/<package>/path...).
|
-- (e.g. github.com/golang/<package>/path...).
|
||||||
(_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs)
|
(_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs)
|
||||||
_ -> throwResumable $ GoImportError path
|
_ -> throwResumable $ GoImportError path
|
||||||
|
|
||||||
-- | Import declarations (symbols are added directly to the calling environment).
|
-- | Import declarations (symbols are added directly to the calling environment).
|
||||||
--
|
--
|
||||||
|
Loading…
Reference in New Issue
Block a user