github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00
Code Issues Projects Releases Wiki Activity

Add an ImportGraph task.

Browse Source
This commit is contained in:
Rob Rix 2018-04-04 11:58:53 -04:00
parent aaa5017d6d
commit 2795e9cf55
1 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Semantic/Task.hs
View File

@ -15,6 +15,8 @@ module Semantic.Task
, decorate , decorate
, diff , diff
, render , render
, importGraph
-- TODO: group these
, distribute , distribute
, distributeFor , distributeFor
, distributeFoldMap , distributeFoldMap
@ -29,13 +31,21 @@ module Semantic.Task
, throwError , throwError
) where ) where
import qualified Analysis.Abstract.ImportGraph as Abstract
import Analysis.Abstract.Evaluating
import Analysis.Decorator (decoratorWithAlgebra) import Analysis.Decorator (decoratorWithAlgebra)
import qualified Assigning.Assignment as Assignment import qualified Assigning.Assignment as Assignment
import qualified Control.Abstract.Analysis as Analysis
import qualified Control.Exception as Exc import qualified Control.Exception as Exc
import Control.Monad.Effect.Exception import Control.Monad.Effect.Exception
import Control.Monad.Effect.Internal as Eff import Control.Monad.Effect.Internal as Eff
import Control.Monad.Effect.Reader import Control.Monad.Effect.Reader
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Abstract.Address
import qualified Data.Abstract.Evaluatable as Analysis
import Data.Abstract.FreeVariables
import Data.Abstract.Package
import Data.Abstract.Value (Value)
import Data.Blob import Data.Blob
import Data.Bool import Data.Bool
import qualified Data.ByteString as B import qualified Data.ByteString as B
@ -63,6 +73,7 @@ data TaskF output where
ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [BlobPair] ReadBlobPairs :: Either Handle [Both (FilePath, Maybe Language)] -> TaskF [BlobPair]
WriteToOutput :: Either Handle FilePath -> B.ByteString -> TaskF () WriteToOutput :: Either Handle FilePath -> B.ByteString -> TaskF ()
Parse :: Parser term -> Blob -> TaskF term Parse :: Parser term -> Blob -> TaskF term
ImportGraph :: (Corecursive term, Analysis.Evaluatable (Base term), FreeVariables term, Recursive term) => PackageBody term -> TaskF B.ByteString
Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields))) Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> TaskF (Term f (Record (field ': fields)))
Diff :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> TaskF (Diff syntax ann1 ann2) Diff :: Differ syntax ann1 ann2 -> Term syntax ann1 -> Term syntax ann2 -> TaskF (Diff syntax ann1 ann2)
Render :: Renderer input output -> input -> TaskF output Render :: Renderer input output -> input -> TaskF output
@ -109,6 +120,10 @@ render :: Member TaskF effs => Renderer input output -> input -> Eff effs output
render renderer = send . Render renderer render renderer = send . Render renderer
importGraph :: (Corecursive term, Analysis.Evaluatable (Base term), FreeVariables term, Recursive term) => Member TaskF effs => PackageBody term -> Eff effs B.ByteString
importGraph package = send (ImportGraph package)
-- | Execute a 'Task' with the 'defaultOptions', yielding its result value in 'IO'. -- | Execute a 'Task' with the 'defaultOptions', yielding its result value in 'IO'.
-- --
-- > runTask = runTaskWithOptions defaultOptions -- > runTask = runTaskWithOptions defaultOptions
@ -177,7 +192,7 @@ runParser blob@Blob{..} parser = case parser of
runTaskF :: Members '[Reader Options, Telemetry, Reader LogQueue, Reader StatQueue, Exc SomeException, IO] effs => Eff (TaskF ': effs) a -> Eff effs a runTaskF :: Members '[Reader Options, Telemetry, Reader LogQueue, Reader StatQueue, Exc SomeException, IO] effs => Eff (TaskF ': effs) a -> Eff effs a
runTaskF = interpret (\ task -> case task of runTaskF = interpret $ \ task -> case task of
ReadBlobs (Left handle) -> rethrowing (IO.readBlobsFromHandle handle) ReadBlobs (Left handle) -> rethrowing (IO.readBlobsFromHandle handle)
ReadBlobs (Right paths@[(path, Nothing)]) -> rethrowing (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path)) ReadBlobs (Right paths@[(path, Nothing)]) -> rethrowing (IO.isDirectory path >>= bool (IO.readBlobsFromPaths paths) (IO.readBlobsFromDir path))
ReadBlobs (Right paths) -> rethrowing (IO.readBlobsFromPaths paths) ReadBlobs (Right paths) -> rethrowing (IO.readBlobsFromPaths paths)
@ -186,7 +201,14 @@ runTaskF = interpret (\ task -> case task of
Parse parser blob -> runParser blob parser Parse parser blob -> runParser blob parser
Decorate algebra term -> pure (decoratorWithAlgebra algebra term) Decorate algebra term -> pure (decoratorWithAlgebra algebra term)
Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2) Semantic.Task.Diff differ term1 term2 -> pure (differ term1 term2)
Render renderer input -> pure (renderer input)) Render renderer input -> pure (renderer input)
ImportGraph package -> do
let result = Analysis.runAnalysis (Analysis.evaluatePackageBody package `asAnalysisForTypeOfPackage` package)
case result of
(Right (Right (Right (Right (Right (_, graph))))), _) -> pure $ Abstract.renderImportGraph graph
_ -> error "blah"
where asAnalysisForTypeOfPackage :: Abstract.ImportGraphing (Evaluating Precise term (Value Precise)) effects value -> PackageBody term -> Abstract.ImportGraphing (Evaluating Precise term (Value Precise)) effects value
asAnalysisForTypeOfPackage = const
-- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function. -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.