1
1
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00

Merge branch 'master' into re-enable-tracing-analyses

This commit is contained in:
Rob Rix 2018-03-12 12:09:13 -04:00
commit 7794d9423b
24 changed files with 239 additions and 109 deletions

29
bench/Main.hs Normal file
View File

@ -0,0 +1,29 @@
module Main where
import Criterion.Main
import Semantic.Util
import Data.Monoid
import Control.Monad
-- We use `fmap show` to ensure that all the parts of the result of evaluation are
-- evaluated themselves. While an NFData instance is the most morally correct way
-- to do this, I'm reluctant to add NFData instances to every single datatype in the
-- project—coercing the result into a string will suffice, though it throws off the
-- memory allocation results a bit.
pyEval :: FilePath -> Benchmarkable
pyEval = whnfIO . fmap show . evaluatePythonFile . ("bench/bench-fixtures/python/" <>)
rbEval :: FilePath -> Benchmarkable
rbEval = whnfIO . fmap show . evaluateRubyFile . ("bench/bench-fixtures/ruby/" <>)
main :: IO ()
main = defaultMain
[ bgroup "python" [ bench "assignment" $ pyEval "simple-assignment.py"
, bench "function def" $ pyEval "function-definition.py"
, bench "if + function calls" $ pyEval "if-statement-functions.py"
]
, bgroup "ruby" [ bench "assignment" $ rbEval "simple-assignment.rb"
, bench "function def" $ rbEval "function-definition.rb"
, bench "if + function calls" $ rbEval "if-statement-functions.rb"
]
]

View File

@ -0,0 +1,14 @@
def a():
b
def c(d):
e
def g(g, *h):
i
def h(i=1):
i
def i(j="default", **c):
j

View File

@ -0,0 +1,12 @@
def foo(): return "bipp"
def bar(): return foo()
def baz(): return bar()
def why(): return "elle"
if True:
baz()
else:
why()

View File

@ -0,0 +1,5 @@
foo = 2
bar = foo
dang = 3
song = dang
song

View File

@ -0,0 +1,19 @@
def a()
"b"
end
def c(d)
"e"
end
def g(g_)
"i"
end
def h(i=1)
i
end
def i()
"j"
end

View File

@ -0,0 +1,21 @@
def foo()
"bipp"
end
def bar()
foo()
end
def baz()
bar()
end
def why()
return "elle"
end
if true
baz()
else
why()
end

View File

@ -0,0 +1,5 @@
foo = 2
bar = foo
dang = 3
song = dang
song

View File

@ -37,7 +37,6 @@ library
-- Control flow
, Control.Effect
-- Effects used for program analysis
, Control.Monad.Effect.Cache
, Control.Monad.Effect.Fresh
-- , Control.Monad.Effect.GC
, Control.Monad.Effect.NonDet
@ -141,7 +140,6 @@ library
, bifunctors
, bytestring
, cmark-gfm
, comonad
, containers
, directory
, effects
@ -252,6 +250,18 @@ test-suite test
default-language: Haskell2010
default-extensions: DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards
benchmark evaluation
hs-source-dirs: bench
type: exitcode-stdio-1.0
main-is: Main.hs
ghc-options: -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m -T" -static -j -O
cc-options: -DU_STATIC_IMPLEMENTATION=1
cpp-options: -DU_STATIC_IMPLEMENTATION=1
build-depends: base
, criterion
, semantic
source-repository head
type: git
location: https://github.com/github/semantic

View File

@ -1,63 +0,0 @@
{-# LANGUAGE MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
module Control.Monad.Effect.Cache where
import Control.Monad.Effect
import Control.Monad.Effect.Reader
import Control.Monad.Effect.State
import Data.Abstract.Cache
import Data.Abstract.Value
-- | 'Monad's offering a readable 'Cache' of values & stores for each configuration in a program.
--
-- This (in-)cache is used as an oracle for the results of recursive computations, allowing us to finitize potentially nonterminating control flow by repeatedly computing the results until analysis converges on a stable value. Each iteration of this process must consult this cache only _after_ evaluating the configuration itself in order to ensure soundness (since it could otherwise produce stale results for some configurations).
--
-- Since finitization crucially depends on convergence, this cache should only be used with value abstractions that will converge for multiple disjoint assignments of a given variable, e.g. its type, and not with precisely-modelled values. To illustrate why, consider a simple incrementing recursive function:
--
-- > inc :: Integer -> a
-- > inc n = inc (n + 1)
--
-- @n@ differs at every iteration, and thus a precise modelling of the integral value will not converge in the store: each iteration will allocate a new address & write a distinct value into it. Modelling values with their types _will_ converge, however, as the type at each iteration is the same.
class Monad m => MonadCacheIn t v m where
-- | Retrieve the local in-cache.
askCache :: m (Cache (LocationFor v) t v)
-- | Run a computation with a locally-modified in-cache.
localCache :: (Cache (LocationFor v) t v -> Cache (LocationFor v) t v) -> m a -> m a
instance (Reader (Cache (LocationFor v) t v) :< fs) => MonadCacheIn t v (Eff fs) where
askCache = ask
localCache = local
-- | Project a value out of the in-cache.
asksCache :: MonadCacheIn t v m => (Cache (LocationFor v) t v -> a) -> m a
asksCache f = f <$> askCache
-- | 'Monad's offering a readable & writable 'Cache' of values & stores for each configuration in a program.
--
-- This (out-)cache is used to store the results of recursive computations, allowing us to finitize each iteration of an analysis by first looking up the current configuration in the cache and only evaluating:
--
-- 1. If the configuration has not been visited before, and
-- 2. _after_ copying the previous iterations results (from the in-cache, and defaulting to a 'mempty' set of results) into the out-cache.
--
-- Thus, visiting the same configuration twice recursively will terminate, since well have consulted the in-cache as an oracle before evaluating, and after evaluating, the resulting value and store should be appended into the out-cache. Then, once the current iteration of the analysis has completed, the updated out-cache will be used as the oracle for the next iteration, until such time as the cache converges.
--
-- See also 'MonadCacheIn' for discussion of the conditions of finitization.
class Monad m => MonadCacheOut t v m where
-- | Retrieve the current out-cache.
getCache :: m (Cache (LocationFor v) t v)
-- | Update the current out-cache.
putCache :: Cache (LocationFor v) t v -> m ()
instance (State (Cache (LocationFor v) t v) :< fs) => MonadCacheOut t v (Eff fs) where
getCache = get
putCache = put
-- | Project a value out of the out-cache.
getsCache :: MonadCacheOut t v m => (Cache (LocationFor v) t v -> a) -> m a
getsCache f = f <$> getCache
-- | Modify the current out-cache using a given function.
modifyCache :: MonadCacheOut t v m => (Cache (LocationFor v) t v -> Cache (LocationFor v) t v) -> m ()
modifyCache f = fmap f getCache >>= putCache

View File

@ -156,8 +156,19 @@ instance Eq1 Module where liftEq = genericLiftEq
instance Ord1 Module where liftCompare = genericLiftCompare
instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Module
instance Evaluatable Module
-- TODO: Fix this extremely bogus instance (copied from that of Program)
-- In Go, functions in the same module can be spread across files.
-- We need to ensure that all input files have aggregated their content into
-- a coherent module before we begin evaluating a module.
instance Evaluatable Module where
eval (Module _ xs) = eval' xs
where
eval' [] = unit >>= interface
eval' [x] = subtermValue x >>= interface
eval' (x:xs) = do
_ <- subtermValue x
env <- getGlobalEnv
localEnv (envUnion env) (eval' xs)
-- | A decorator in Python
data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }

View File

@ -2,51 +2,70 @@
module Language.Go.Syntax where
import Prologue
import Data.Abstract.Evaluatable
import Diffing.Algorithm
-- A composite literal in Go
data Composite a = Composite { compositeType :: !a, compositeElement :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Composite where liftEq = genericLiftEq
instance Ord1 Composite where liftCompare = genericLiftCompare
instance Show1 Composite where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Composite
instance Evaluatable Composite
-- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`).
newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 DefaultPattern where liftEq = genericLiftEq
instance Ord1 DefaultPattern where liftCompare = genericLiftCompare
instance Show1 DefaultPattern where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for DefaultPattern
instance Evaluatable DefaultPattern
-- | A defer statement in Go (e.g. `defer x()`).
newtype Defer a = Defer { deferBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Defer where liftEq = genericLiftEq
instance Ord1 Defer where liftCompare = genericLiftCompare
instance Show1 Defer where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Defer
instance Evaluatable Defer
-- | A go statement (i.e. go routine) in Go (e.g. `go x()`).
newtype Go a = Go { goBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Go where liftEq = genericLiftEq
instance Ord1 Go where liftCompare = genericLiftCompare
instance Show1 Go where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Go
instance Evaluatable Go
-- | A label statement in Go (e.g. `label:continue`).
data Label a = Label { _labelName :: !a, labelStatement :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Label where liftEq = genericLiftEq
instance Ord1 Label where liftCompare = genericLiftCompare
instance Show1 Label where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Label
instance Evaluatable Label
-- | A rune literal in Go (e.g. `'⌘'`).
newtype Rune a = Rune { _runeLiteral :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-- TODO: Implement Eval instance for Rune
instance Evaluatable Rune
instance Eq1 Rune where liftEq = genericLiftEq
instance Ord1 Rune where liftCompare = genericLiftCompare
@ -54,7 +73,10 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec
-- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels).
data Select a = Select { selectCases :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-- TODO: Implement Eval instance for Select
instance Evaluatable Select
instance Eq1 Select where liftEq = genericLiftEq
instance Ord1 Select where liftCompare = genericLiftCompare
@ -62,80 +84,110 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec
-- | A send statement in Go (e.g. `channel <- value`).
data Send a = Send { sendReceiver :: !a, sendValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Send where liftEq = genericLiftEq
instance Ord1 Send where liftCompare = genericLiftCompare
instance Show1 Send where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Send
instance Evaluatable Send
-- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity).
data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Slice where liftEq = genericLiftEq
instance Ord1 Slice where liftCompare = genericLiftCompare
instance Show1 Slice where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Slice
instance Evaluatable Slice
-- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`).
data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeSwitch where liftEq = genericLiftEq
instance Ord1 TypeSwitch where liftCompare = genericLiftCompare
instance Show1 TypeSwitch where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for TypeSwitch
instance Evaluatable TypeSwitch
-- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`).
newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq
instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare
instance Show1 TypeSwitchGuard where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for TypeSwitchGuard
instance Evaluatable TypeSwitchGuard
-- | A receive statement in a Go select statement (e.g. `case value := <-channel` )
data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Receive where liftEq = genericLiftEq
instance Ord1 Receive where liftCompare = genericLiftCompare
instance Show1 Receive where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Receive
instance Evaluatable Receive
-- | A receive operator unary expression in Go (e.g. `<-channel` )
data ReceiveOperator a = ReceiveOperator a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ReceiveOperator where liftEq = genericLiftEq
instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare
instance Show1 ReceiveOperator where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for ReceiveOperator
instance Evaluatable ReceiveOperator
-- | A field declaration in a Go struct type declaration.
data Field a = Field { fieldContext :: ![a], fieldName :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Field where liftEq = genericLiftEq
instance Ord1 Field where liftCompare = genericLiftCompare
instance Show1 Field where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Field
instance Evaluatable Field
-- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`).
data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeAssertion where liftEq = genericLiftEq
instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for TypeAssertion
instance Evaluatable TypeAssertion
-- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`).
data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeConversion where liftEq = genericLiftEq
instance Ord1 TypeConversion where liftCompare = genericLiftCompare
instance Show1 TypeConversion where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for TypeConversion
instance Evaluatable TypeConversion
-- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`).
data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Variadic where liftEq = genericLiftEq
instance Ord1 Variadic where liftCompare = genericLiftCompare
instance Show1 Variadic where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for Variadic
instance Evaluatable Variadic

View File

@ -2,28 +2,38 @@
module Language.Go.Type where
import Prologue
import Data.Abstract.Evaluatable
import Diffing.Algorithm
-- | A Bidirectional channel in Go (e.g. `chan`).
newtype BidirectionalChannel a = BidirectionalChannel a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 BidirectionalChannel where liftEq = genericLiftEq
instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare
instance Show1 BidirectionalChannel where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for BidirectionalChannel
instance Evaluatable BidirectionalChannel
-- | A Receive channel in Go (e.g. `<-chan`).
newtype ReceiveChannel a = ReceiveChannel a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ReceiveChannel where liftEq = genericLiftEq
instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare
instance Show1 ReceiveChannel where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for ReceiveChannel
instance Evaluatable ReceiveChannel
-- | A Send channel in Go (e.g. `chan<-`).
newtype SendChannel a = SendChannel a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 SendChannel where liftEq = genericLiftEq
instance Ord1 SendChannel where liftCompare = genericLiftCompare
instance Show1 SendChannel where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for SendChannel
instance Evaluatable SendChannel

View File

@ -27,13 +27,17 @@ import Semantic
import Semantic.IO as IO
import Semantic.Task
import qualified Language.Go.Assignment as Go
import qualified Language.Python.Assignment as Python
import qualified Language.Ruby.Assignment as Ruby
import qualified Language.TypeScript.Assignment as TypeScript
type RubyValue = Value Precise (Term (Union Ruby.Syntax) (Record Location))
type PythonValue = Value Precise (Term (Union Python.Syntax) (Record Location))
type TypeScriptValue = Value Precise (Term (Union TypeScript.Syntax) (Record Location))
type Language a = Value Precise (Term (Union a) (Record Location))
type GoValue = Language Go.Syntax
type RubyValue = Language Ruby.Syntax
type PythonValue = Language Python.Syntax
type TypeScriptValue = Language TypeScript.Syntax
file :: MonadIO m => FilePath -> m Blob
file path = fromJust <$> IO.readFile path (languageForFilePath path)
@ -45,6 +49,13 @@ evaluateRubyFiles paths = do
first:rest <- traverse (parseFile rubyParser) paths
pure $ evaluates @RubyValue rest first
-- Go
typecheckGoFile path = runAnalysis @(Caching Evaluating Go.Term Type) . evaluateModule . snd <$>
parseFile goParser path
evaluateGoFile path = runAnalysis @(Evaluating Go.Term GoValue) . evaluateModule . snd <$>
parseFile goParser path
-- Python
typecheckPythonFile path = runAnalysis @(Caching Evaluating Python.Term Type) . evaluateModule . snd <$> parseFile pythonParser path

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DataKinds #-}
module Assigning.Assignment.Spec where
module Assigning.Assignment.Spec (spec) where
import Assigning.Assignment
import Data.AST

View File

@ -1,4 +1,4 @@
module Data.Functor.Classes.Generic.Spec where
module Data.Functor.Classes.Generic.Spec (spec) where
import Data.Functor.Classes.Generic
import Data.Functor.Listable

View File

@ -1,5 +1,5 @@
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Data.Mergeable.Spec where
module Data.Mergeable.Spec (spec) where
import Control.Applicative (Alternative(..))
import Data.Functor.Identity

View File

@ -1,4 +1,4 @@
module Data.Source.Spec where
module Data.Source.Spec (spec) where
import Data.Char (chr)
import Data.Functor.Listable

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, OverloadedStrings #-}
module Integration.Spec where
module Integration.Spec (spec) where
import qualified Data.ByteString as B
import Data.Foldable (find, traverse_)

View File

@ -1,4 +1,4 @@
module Rendering.Imports.Spec where
module Rendering.Imports.Spec (spec) where
import Analysis.Declaration (HasDeclaration, declarationAlgebra)
import Analysis.ModuleDef (HasModuleDef, moduleDefAlgebra)
@ -10,7 +10,7 @@ import qualified Data.Map as Map
import qualified Semantic.Util as Util
import Rendering.Imports
import Rendering.Renderer
import Rendering.TOC.Spec
import Rendering.TOC.Spec hiding (spec)
import Semantic
import Semantic.Task
import SpecHelpers

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DataKinds, TypeOperators #-}
module Rendering.TOC.Spec where
module Rendering.TOC.Spec (spec) where
import Analysis.Decorator (constructorNameAndConstantFields)
import Analysis.Declaration

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DuplicateRecordFields #-}
module Semantic.CLI.Spec where
module Semantic.CLI.Spec (spec) where
import Control.Monad (when)
import Data.ByteString (ByteString)

View File

@ -1,4 +1,4 @@
module Semantic.IO.Spec where
module Semantic.IO.Spec (spec) where
import Data.Blob
import Data.Functor.Both as Both

View File

@ -1,4 +1,4 @@
module Semantic.Stat.Spec where
module Semantic.Stat.Spec (spec) where
import Semantic.Stat
import Test.Hspec hiding (shouldBe, shouldNotBe, shouldThrow, errorCall)

View File

@ -3,7 +3,6 @@ module SpecHelpers
( diffFilePaths
, parseFilePath
, readFilePair
, languageForFilePath
, Verbatim(..)
, verbatim
, readFileVerbatim
@ -31,18 +30,13 @@ diffFilePaths paths = readFilePair paths >>= runTask . diffBlobPair SExpressionD
-- | Returns an s-expression parse tree for the specified FilePath.
parseFilePath :: FilePath -> IO B.ByteString
parseFilePath path = IO.readFile path (languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer
parseFilePath path = IO.readFile path (IO.languageForFilePath path) >>= pure . fromJust >>= runTask . parseBlob SExpressionTermRenderer
-- | Read two files to a BlobPair.
readFilePair :: Both FilePath -> IO BlobPair
readFilePair paths = let paths' = fmap (\p -> (p, languageForFilePath p)) paths in
readFilePair paths = let paths' = fmap (\p -> (p, IO.languageForFilePath p)) paths in
runBothWith IO.readFilePair paths'
-- | Returns a Maybe Language based on the FilePath's extension.
languageForFilePath :: FilePath -> Maybe Language
languageForFilePath = languageForType . takeExtension
readFileVerbatim :: FilePath -> IO Verbatim
readFileVerbatim = fmap verbatim . B.readFile