github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-23 16:37:50 +03:00
Code Issues Projects Releases Wiki Activity

semantic:exe now compiles

Browse Source
This commit is contained in:
Patrick Thomson 2019-12-10 13:32:56 -05:00
parent 5f6ad2a1cf
commit 68ab3cbb97
40 changed files with 73 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
cabal.project
View File

@ -9,6 +9,8 @@ packages: .
jobs: $ncpus
allow-newer: all:template-haskell
package semantic
ghc-options: -Werror
@ -36,9 +38,15 @@ package semantic-ast
source-repository-package
type: git
location: https://github.com/tclem/proto-lens-jsonpb
tag: e4d10b77f57ee25beb759a33e63e2061420d3dc2
tag: 5d40444be689bef1e12cbe38da0261283775ec64
source-repository-package
type: git
location: https://github.com/antitypical/fused-syntax.git
tag: 6b412694e64cc275ed06513b3c360f03bb1f04fd
source-repository-package
type: git
location: https://github.com/patrickt/fastsum
tag: 3d12bb7a55a74dcebf3603261c8bb62b34c74693

2
semantic-analysis/semantic-analysis.cabal
View File

@ -58,7 +58,7 @@ library
, fused-syntax
, haskeline ^>= 0.7.5
, pathtype ^>= 0.8.1
, prettyprinter ^>= 1.2.1
, prettyprinter >= 1.2.1 && < 1.4
, prettyprinter-ansi-terminal ^>= 1.1.1
, semantic-source ^>= 0
, terminal-size ^>= 0.3

7
semantic-analysis/src/Analysis/Concrete.hs
View File

@ -1,4 +1,6 @@
{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns,
OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators,
UndecidableInstances #-}
module Analysis.Concrete
( Concrete(..)
, concrete
@ -13,14 +15,13 @@ import qualified Algebra.Graph as G
import qualified Algebra.Graph.Export.Dot as G
import Analysis.Analysis
import Analysis.File
import Control.Applicative (Alternative (..))
import Control.Carrier.Fail.WithLoc
import Control.Effect
import Control.Effect.Fresh
import Control.Effect.NonDet
import Control.Effect.Reader hiding (Local)
import Control.Effect.State
import Control.Monad ((<=<), guard)
import Control.Monad (guard, (<=<))
import Data.Function (fix)
import qualified Data.IntMap as IntMap
import qualified Data.IntSet as IntSet

18
semantic-ast/semantic-ast.cabal
View File

@ -40,12 +40,12 @@ library
exposed-modules:
-- other-modules:
-- other-extensions:
build-depends: base ^>=4.12.0.0
build-depends: base >= 4.12 && < 4.14
, tree-sitter ^>= 0.5
, semantic-source ^>= 0.0
, tree-sitter-python ^>= 0.6
, bytestring ^>= 0.10.8.2
, optparse-applicative ^>= 0.14.3.0
, optparse-applicative >= 0.14.3 && < 0.16
, pretty-simple ^>= 3.1.0.0
hs-source-dirs: src
default-language: Haskell2010
@ -55,13 +55,13 @@ executable semantic-ast
main-is: Main.hs
-- other-modules:
-- other-extensions:
build-depends: base ^>=4.12.0.0
build-depends: base
, semantic-ast
, tree-sitter ^>= 0.5
, semantic-source ^>= 0.0
, tree-sitter-python ^>= 0.6
, bytestring ^>= 0.10.8.2
, optparse-applicative ^>= 0.14.3.0
, pretty-simple ^>= 3.1.0.0
, tree-sitter
, semantic-source
, tree-sitter-python
, bytestring
, optparse-applicative
, pretty-simple
hs-source-dirs: src
default-language: Haskell2010

4
semantic-core/semantic-core.cabal
View File

@ -51,12 +51,12 @@ library
, fused-syntax
, parsers ^>= 0.12.10
, pathtype ^>= 0.8.1
, prettyprinter ^>= 1.2.1
, prettyprinter >= 1.2.1 && < 1.4
, prettyprinter-ansi-terminal ^>= 1.1.1
, semantic-analysis ^>= 0
, semantic-source ^>= 0
, text ^>= 1.2.3.1
, trifecta ^>= 2
, trifecta >= 2 && < 2.2
, unordered-containers ^>= 0.2.10
test-suite test

5
semantic-python/semantic-python.cabal
View File

@ -20,7 +20,7 @@ tested-with: GHC == 8.6.5
common haskell
default-language: Haskell2010
build-depends: base ^>=4.12
build-depends: base >= 4.12 && < 4.14
, fused-effects ^>= 0.5
, fused-syntax
, parsers ^>= 0.12.10
@ -43,7 +43,8 @@ common haskell
-Wno-missed-specialisations
-Wno-all-missed-specialisations
-Wno-star-is-type
if (impl(ghc >= 8.8))
ghc-options: -Wno-missing-deriving-strategies
library

2
semantic-tags/semantic-tags.cabal
View File

@ -42,3 +42,5 @@ library
-Wno-missed-specialisations
-Wno-all-missed-specialisations
-Wno-star-is-type
if (impl(ghc >= 8.8))
ghc-options: -Wno-missing-deriving-strategies

16
semantic.cabal
View File

@ -57,7 +57,7 @@ common dependencies
, fastsum ^>= 0.1.1.0
, fused-effects ^>= 0.5.0.0
, fused-effects-exceptions ^>= 0.2.0.0
, hashable ^>= 1.2.7.0
, hashable >= 1.2.7 && < 1.4
, tree-sitter ^>= 0.5
, mtl ^>= 2.2.2
, network ^>= 2.8.0.0
@ -270,18 +270,18 @@ library
, hostname ^>= 1.0
, hscolour ^>= 1.24.4
, kdt ^>= 0.2.4
, lens ^>= 4.17
, lens >= 4.17 && < 4.19
, mersenne-random-pure64 ^>= 0.2.2.0
, network-uri ^>= 2.6.1.0
, optparse-applicative ^>= 0.14.3.0
, optparse-applicative >= 0.14.3 && < 0.16
, parallel ^>= 3.2.2.0
, parsers ^>= 0.12.9
, prettyprinter ^>= 1.2.1
, prettyprinter >= 1.2.1 && < 1.4
, pretty-show ^>= 1.9.5
, profunctors ^>= 5.3
, proto-lens ^>= 0.5.1.0
, proto-lens >= 0.5 && < 0.7
, proto-lens-jsonpb
, proto-lens-runtime ^>= 0.5.0.0
, proto-lens-runtime >= 0.5 && <0.7
, reducers ^>= 3.12.3
, semantic-java ^>= 0
, semantic-json ^>= 0
@ -290,8 +290,8 @@ library
, semigroupoids ^>= 5.3.2
, split ^>= 0.2.3.3
, stm-chans ^>= 3.0.0.4
, template-haskell ^>= 2.14
, time ^>= 1.8.0.2
, template-haskell >= 2.14 && < 2.16
, time >= 1.8.0.2 && < 1.10
, utf8-string ^>= 1.0.1.1
, unliftio-core ^>= 0.1.2.0
, unordered-containers ^>= 0.2.9.0

1
src/Analysis/Abstract/Graph.hs
View File

@ -21,7 +21,6 @@ import Control.Abstract hiding (Function(..))
import Control.Effect.Carrier
import Data.Abstract.BaseError
import Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..))
import Data.Abstract.Package (PackageInfo (..))
import Data.ByteString.Builder
import Data.Graph
import Data.Graph.ControlFlowVertex

1
src/Assigning/Assignment.hs
View File

@ -98,7 +98,6 @@ import Data.AST
import Data.Error
import qualified Source.Source as Source
import Data.Term
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8')
import qualified Source.Loc as L
import Source.Range as Range

9
src/Control/Abstract/Heap.hs
View File

@ -1,4 +1,6 @@
{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators,
UndecidableInstances #-}
module Control.Abstract.Heap
( Heap
, HeapError(..)
@ -47,7 +49,6 @@ import Control.Abstract.Evaluator
import Control.Abstract.Roots
import Control.Abstract.ScopeGraph hiding (ScopeError (..))
import Control.Abstract.ScopeGraph (ScopeError)
import Control.Applicative (Alternative)
import Control.Effect.Carrier
import Data.Abstract.BaseError
import Data.Abstract.Heap (Heap, Position (..))
@ -55,7 +56,7 @@ import qualified Data.Abstract.Heap as Heap
import Data.Abstract.Live
import Data.Abstract.Module (ModuleInfo)
import Data.Abstract.Name
import Data.Abstract.ScopeGraph (Kind(..), Path (..), Relation(..), putDeclarationScopeAtPosition)
import Data.Abstract.ScopeGraph (Kind (..), Path (..), putDeclarationScopeAtPosition)
import qualified Data.Map.Strict as Map
import Prologue
import Source.Span (Span)
@ -483,7 +484,7 @@ instance Show address => Show1 (AddressError address value) where
instance Eq address => Eq1 (AddressError address value) where
liftEq _ (UninitializedSlot a) (UninitializedSlot b) = a == b
liftEq _ (UnallocatedSlot a) (UnallocatedSlot b) = a == b
liftEq _ _ _ = False
liftEq _ _ _ = False
throwAddressError :: ( Member (Resumable (BaseError (AddressError address body))) sig
, Member (Reader ModuleInfo) sig

5
src/Control/Abstract/Value.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators #-}
{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators #-}
module Control.Abstract.Value
( AbstractValue(..)
, AbstractIntro(..)
@ -73,7 +74,7 @@ module Control.Abstract.Value
import Control.Abstract.Evaluator
import Control.Abstract.Heap
import Control.Abstract.ScopeGraph (Allocator, CurrentScope, Declaration, ScopeGraph)
import Control.Abstract.ScopeGraph (CurrentScope, Declaration, ScopeGraph)
import Control.Effect.Carrier
import Data.Abstract.BaseError
import Data.Abstract.Module

2
src/Control/Carrier/Parse/Measured.hs
View File

@ -32,7 +32,7 @@ import Semantic.Timeout
import Source.Source (Source)
newtype ParseC m a = ParseC { runParse :: m a }
deriving (Applicative, Functor, Monad, MonadIO)
deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
instance ( Carrier sig m
, Member (Error SomeException) sig

2
src/Control/Carrier/Parse/Simple.hs
View File

@ -26,7 +26,7 @@ runParse :: Duration -> ParseC m a -> m a
runParse timeout = runReader timeout . runParseC
newtype ParseC m a = ParseC { runParseC :: ReaderC Duration m a }
deriving (Applicative, Functor, Monad, MonadIO)
deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
instance ( Carrier sig m
, Member (Error SomeException) sig

1
src/Data/Abstract/Address/Precise.hs
View File

@ -4,7 +4,6 @@ module Data.Abstract.Address.Precise
) where
import Control.Abstract
import Control.Abstract.ScopeGraph (AllocatorC(..))
import Control.Effect.Carrier
import qualified Data.Set as Set
import Prologue

1
src/Data/Abstract/Evaluatable.hs
View File

@ -29,7 +29,6 @@ import Data.Abstract.FreeVariables as X
import Data.Abstract.Module
import Data.Abstract.Name as X
import qualified Data.Abstract.ScopeGraph as ScopeGraph
import Data.Abstract.ScopeGraph (Relation(..))
import Data.Abstract.AccessControls.Class as X
import Data.Language
import Data.Scientific (Scientific)

1
src/Data/Abstract/Name.hs
View File

@ -12,7 +12,6 @@ module Data.Abstract.Name
import Control.Effect.Fresh
import Data.Aeson
import qualified Data.Char as Char
import Data.Text (Text)
import qualified Data.Text as Text
import Prologue

3
src/Data/Abstract/Value/Concrete.hs
View File

@ -6,8 +6,6 @@ module Data.Abstract.Value.Concrete
, runValueErrorWith
) where
import Control.Abstract.ScopeGraph (Allocator, ScopeError)
import Control.Abstract.Heap (scopeLookup)
import qualified Control.Abstract as Abstract
import Control.Abstract hiding (Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..))
import Control.Effect.Carrier
@ -19,7 +17,6 @@ import Data.Abstract.Name
import qualified Data.Abstract.Number as Number
import Data.Bits
import Data.List (genericIndex, genericLength)
import Data.Scientific (Scientific, coefficient, normalize)
import Data.Scientific.Exts
import Data.Text (pack)
import Data.Word

4
src/Data/Blob/IO.hs
View File

@ -25,10 +25,10 @@ readBlobFromFile (File path language) = do
pure . Just . sourceBlob path language . Source.fromUTF8 $ raw
-- | Read a utf8-encoded file to a 'Blob', raising an IOError if it can't be found.
readBlobFromFile' :: MonadIO m => File -> m Blob
readBlobFromFile' :: (MonadFail m, MonadIO m) => File -> m Blob
readBlobFromFile' file = do
maybeFile <- readBlobFromFile file
maybeM (Prelude.fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
-- | Read all blobs in the directory with Language.supportedExts.
readBlobsFromDir :: MonadIO m => Path.AbsRelDir -> m [Blob]

1
src/Data/Error.hs
View File

@ -14,7 +14,6 @@ module Data.Error
import Prologue
import Data.ByteString.Char8 (unpack)
import Data.Ix (inRange)
import Data.List (intersperse, isSuffixOf)
import System.Console.ANSI

1
src/Data/Graph/ControlFlowVertex.hs
View File

@ -20,7 +20,6 @@ import Data.Abstract.Name
import Data.Abstract.Package (PackageInfo (..))
import Data.Aeson
import Data.Graph (VertexTag (..))
import qualified Data.Graph as G
import Data.Quieterm (Quieterm(..))
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Declaration as Declaration

4
src/Data/JSON/Fields.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, OverloadedStrings,
RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
module Data.JSON.Fields
( JSONFields (..)
, JSONFields1 (..)
@ -10,7 +11,6 @@ module Data.JSON.Fields
import Data.Aeson
import Data.Edit
import qualified Data.Map as Map
import Data.Sum (Apply (..), Sum)
import qualified Data.Text as Text
import GHC.Generics
import Prologue

1
src/Data/Syntax/Declaration.hs
View File

@ -9,7 +9,6 @@ import qualified Data.Set as Set
import Control.Abstract hiding (AccessControl (..), Function)
import Data.Abstract.Evaluatable
import Data.Abstract.Name (__self)
import qualified Data.Abstract.ScopeGraph as ScopeGraph
import Data.JSON.Fields
import Diffing.Algorithm

1
src/Language/Ruby/Assignment.hs
View File

@ -12,7 +12,6 @@ import Assigning.Assignment hiding (Assignment, Error)
import qualified Assigning.Assignment as Assignment
import Data.Abstract.Name (name)
import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
import Data.List (elem)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Syntax
( contextualize

4
src/Language/Ruby/Syntax.hs
View File

@ -4,10 +4,6 @@ module Language.Ruby.Syntax (module Language.Ruby.Syntax) where
import Prologue
import Control.Abstract as Abstract hiding (Load, String)
import Control.Abstract.Heap (Heap, HeapError, insertFrameLink)
import Control.Abstract.ScopeGraph (insertImportEdge)
import Control.Abstract.Value (Boolean)
import Control.Monad (unless)
import Data.Abstract.BaseError
import Data.Abstract.Evaluatable
import qualified Data.Abstract.Module as M

1
src/Language/TypeScript/Syntax/TypeScript.hs
View File

@ -5,7 +5,6 @@ import Prologue
import Control.Abstract hiding (Import)
import Data.Abstract.Evaluatable as Evaluatable
import Data.Abstract.ScopeGraph (AccessControl (..))
import Data.JSON.Fields
import qualified Data.Map.Strict as Map
import Data.Semigroup.App

4
src/Parsing/TreeSitter.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleContexts, GADTs, LambdaCase, RecordWildCards, ScopedTypeVariables, TypeOperators #-}
{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleContexts, GADTs, LambdaCase, RecordWildCards, ScopedTypeVariables,
TypeOperators #-}
module Parsing.TreeSitter
( TSParseException (..)
, Duration(..)
@ -14,7 +15,6 @@ import Control.Effect.Reader
import qualified Control.Exception as Exc
import Foreign
import Foreign.C.Types (CBool (..))
import Foreign.Marshal.Array (allocaArray)
import Data.AST (AST, Node (Node))
import Data.Blob

14
src/Prologue.hs
View File

@ -9,13 +9,12 @@ module Prologue
) where
import Debug.Trace as X (traceShowM, traceM)
import Data.Bifunctor.Join as X
import Data.Bits as X
import Data.ByteString as X (ByteString)
import Data.Coerce as X
import Data.Int as X (Int8, Int16, Int32, Int64)
import Data.Either as X (fromLeft, fromRight)
import Data.Int as X (Int16, Int32, Int64, Int8)
import Data.IntMap as X (IntMap)
import Data.IntSet as X (IntSet)
import Data.Ix as X (Ix (..))
@ -23,12 +22,13 @@ import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty, some1)
import Data.Map as X (Map)
import Data.Maybe as X
import Data.Monoid (Alt (..))
import Data.Semilattice.Lower as X (Lower (..))
import Data.Sequence as X (Seq)
import Data.Semilattice.Lower as X (Lower(..))
import Data.Set as X (Set)
import Data.Sum as X (Sum, Element, Elements, (:<), (:<:), Apply (..), inject)
import Data.Sum as X ((:<), (:<:), Apply (..), Element, Elements, Sum, inject)
import Data.Text as X (Text)
import Data.Word as X (Word8, Word16, Word32, Word64)
import Data.Word as X (Word16, Word32, Word64, Word8)
import Debug.Trace as X (traceM, traceShowM)
import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo)
@ -44,12 +44,12 @@ import Data.Bifunctor as X (Bifunctor (..))
import Data.Bitraversable as X
import Data.Foldable as X hiding (product, sum)
import Data.Function as X (fix, on, (&))
import Data.Functor as X (void, ($>))
import Data.Functor as X (($>))
import Data.Functor.Classes as X
import Data.Functor.Classes.Generic as X
import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..))
import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt)
import Data.Hashable.Lifted as X (Hashable1(..), hashWithSalt1)
import Data.Hashable.Lifted as X (Hashable1 (..), hashWithSalt1)
import Data.Monoid as X (First (..), Last (..), Monoid (..))
import Data.Monoid.Generic as X
import Data.Profunctor.Unsafe

1
src/Rendering/JSON.hs
View File

@ -13,7 +13,6 @@ module Rendering.JSON
, SomeJSON(..)
) where
import Data.Aeson (ToJSON, toJSON, object, (.=))
import Data.Aeson as A
import Data.Blob
import Data.JSON.Fields

1
src/Semantic/Analysis.hs
View File

@ -10,7 +10,6 @@ import Prologue
import qualified Data.Map.Strict as Map
import Control.Abstract as Abstract
import Control.Abstract.ScopeGraph (runAllocator)
import Control.Effect.Carrier
import Control.Effect.Interpose
import Data.Abstract.Evaluatable

4
src/Semantic/CLI.hs
View File

@ -3,7 +3,6 @@ module Semantic.CLI (main) where
import qualified Control.Carrier.Parse.Measured as Parse
import Control.Effect.Reader
import Control.Exception as Exc (displayException)
import Data.Blob
import Data.Blob.IO
import Data.Handle
@ -27,8 +26,7 @@ import System.FilePath
import qualified System.Path as Path
import qualified System.Path.PartClass as Path.PartClass
import Control.Concurrent (mkWeakThreadId, myThreadId)
import Control.Exception (Exception(..), throwTo)
import Control.Concurrent (throwTo, mkWeakThreadId, myThreadId)
import System.Posix.Signals
import System.Mem.Weak (deRefWeak)
import Proto.Semantic_JSON()

2
src/Semantic/Distribute.hs
View File

@ -56,7 +56,7 @@ withDistribute :: MonadUnliftIO m => DistributeC m a -> m a
withDistribute r = withUnliftIO (`runDistribute` r)
newtype DistributeC m a = DistributeC { runDistributeC :: ReaderC (UnliftIO m) m a }
deriving (Functor, Applicative, Monad, MonadIO)
deriving (Functor, Applicative, Monad, MonadFail, MonadIO)
-- This can be simpler if we add an instance to fused-effects that takes
-- care of this folderol for us (then we can justt derive the MonadUnliftIO instance)

1
src/Semantic/Graph.hs
View File

@ -42,7 +42,6 @@ import Control.Lens.Getter
import Data.Abstract.Address.Hole as Hole
import Data.Abstract.Address.Monovariant as Monovariant
import Data.Abstract.Address.Precise as Precise
import Data.Abstract.BaseError (BaseError (..))
import Data.Abstract.Evaluatable
import Data.Abstract.Heap
import Data.Abstract.Module

3
src/Semantic/Resolution.hs
View File

@ -14,7 +14,6 @@ import Data.Blob
import Data.Language
import qualified Data.Map as Map
import Data.Project
import GHC.Generics (Generic1)
import Prologue
import Semantic.Task.Files
import qualified Source.Source as Source
@ -55,7 +54,7 @@ runResolution :: ResolutionC m a -> m a
runResolution = runResolutionC
newtype ResolutionC m a = ResolutionC { runResolutionC :: m a }
deriving (Applicative, Functor, Monad, MonadIO)
deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
instance (Member Files sig, Carrier sig m, MonadIO m) => Carrier (Resolution :+: sig) (ResolutionC m) where
eff (R other) = ResolutionC . eff . handleCoercible $ other

7
src/Semantic/Task.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Semantic.Task
( TaskC
, Level(..)
@ -87,6 +88,8 @@ serialize format input = do
formatStyle <- asks (Flag.choose IsTerminal Plain Colourful . configIsTerminal)
pure (runSerialize formatStyle format input)
deriving instance MonadFail m => MonadFail (CatchC m)
data TaskSession
= TaskSession
{ config :: Config
@ -134,7 +137,7 @@ runTraceInTelemetry :: TraceInTelemetryC m a
runTraceInTelemetry = runTraceInTelemetryC
newtype TraceInTelemetryC m a = TraceInTelemetryC { runTraceInTelemetryC :: m a }
deriving (Applicative, Functor, Monad, MonadIO)
deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
instance (Member Telemetry sig, Carrier sig m) => Carrier (Trace :+: sig) (TraceInTelemetryC m) where
eff (R other) = TraceInTelemetryC . eff . handleCoercible $ other

4
src/Semantic/Task/Files.hs
View File

@ -67,9 +67,9 @@ runFiles :: FilesC m a -> m a
runFiles = runFilesC
newtype FilesC m a = FilesC { runFilesC :: m a }
deriving (Functor, Applicative, Monad, MonadIO)
deriving (Functor, Applicative, Monad, MonadFail, MonadIO)
instance (Member (Error SomeException) sig, Member Catch sig, MonadIO m, Carrier sig m) => Carrier (Files :+: sig) (FilesC m) where
instance (Member (Error SomeException) sig, Member Catch sig, MonadFail m, MonadIO m, Carrier sig m) => Carrier (Files :+: sig) (FilesC m) where
eff (R other) = FilesC (eff (handleCoercible other))
eff (L op) = case op of
Read (FromPath path) k -> rethrowing (readBlobFromFile' path) >>= k

2
src/Semantic/Telemetry.hs
View File

@ -148,7 +148,7 @@ runTelemetry :: LogQueue -> StatQueue -> TelemetryC m a -> m a
runTelemetry logger statter = runReader (logger, statter) . runTelemetryC
newtype TelemetryC m a = TelemetryC { runTelemetryC :: ReaderC (LogQueue, StatQueue) m a }
deriving (Applicative, Functor, Monad, MonadIO)
deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
instance (Carrier sig m, MonadIO m) => Carrier (Telemetry :+: sig) (TelemetryC m) where
eff (L op) = do

1
src/Semantic/Telemetry/Stat.hs
View File

@ -32,7 +32,6 @@ import qualified Data.ByteString.Char8 as B
import Data.List (intercalate)
import Data.List.Split (splitOneOf)
import qualified Data.Time.Clock as Time
import qualified Data.Time.Clock.POSIX as Time (getCurrentTime)
import Network.Socket
(Socket (..), SocketType (..), addrAddress, addrFamily, close, connect, defaultProtocol, getAddrInfo, socket)
import Network.Socket.ByteString

2
src/Semantic/Timeout.hs
View File

@ -53,7 +53,7 @@ runHandler :: Handler m -> TimeoutC m a -> IO a
runHandler h@(Handler handler) = handler . runReader h . runTimeoutC
newtype TimeoutC m a = TimeoutC { runTimeoutC :: ReaderC (Handler m) m a }
deriving (Functor, Applicative, Monad, MonadIO)
deriving (Functor, Applicative, Monad, MonadFail, MonadIO)
instance MonadUnliftIO m => MonadUnliftIO (TimeoutC m) where
askUnliftIO = TimeoutC . ReaderC $ \(Handler h) ->

4
src/Semantic/Util.hs
View File

@ -12,12 +12,8 @@ module Semantic.Util
import Prelude hiding (readFile)
import Control.Abstract
import Control.Abstract.Heap (runHeapError)
import Control.Abstract.ScopeGraph (runScopeError)
import Control.Carrier.Parse.Simple
import Control.Effect.Lift
import Control.Effect.Trace (runTraceByPrinting)
import Control.Exception (displayException)
import Control.Lens.Getter
import Data.Abstract.Address.Precise as Precise
import Data.Abstract.Evaluatable