mirror of
https://github.com/anoma/juvix.git
synced 2024-12-02 10:47:32 +03:00
6fcc9f21d2
Currently formatting a project is equivalent to running `juvix format`
on each individual file. Hence, the performance is quadratic wrt the
number of modules in the project. This pr fixes that and we now we only
process each module once.
# Benchmark (1236% faster 🚀)
Checking the standard library
```
hyperfine --warmup 1 'juvix format --check' 'juvix-main format --check'
Benchmark 1: juvix format --check
Time (mean ± σ): 450.6 ms ± 33.7 ms [User: 707.2 ms, System: 178.7 ms]
Range (min … max): 396.0 ms … 497.0 ms 10 runs
Benchmark 2: juvix-main format --check
Time (mean ± σ): 6.019 s ± 0.267 s [User: 9.333 s, System: 1.512 s]
Range (min … max): 5.598 s … 6.524 s 10 runs
Summary
juvix format --check ran
13.36 ± 1.16 times faster than juvix-main format --check
```
# Other changes:
1. The `EntryPoint` field `entryPointModulePath` is now optional.
2. I've introduced a new type `TopModulePathKey` which is analogous to
`TopModulePath` but wihout location information. It is used in hashmap
keys where the location in the key is never used. This is useful as we
can now get a `TopModulePathKey` from a `Path Rel File`.
3. I've refactored the `_formatInput` field in `FormatOptions` so that
it doesn't need to be a special case anymore.
4. I've introduced a new effect `Forcing` that allows to individually
force fields of a record type with a convenient syntax.
5. I've refactored some of the constraints in scoping so that they only
require `Reader Package` instead of `Reader EntryPoint`.
6. I've introduced a new type family so that local modules are no longer
required to have `ModuleId` from their type. Before, they were assigned
one, but it was never used.
# Future work:
1. For project-wise formatting, the compilation is done in parallel, but
the formatting is still done sequentially. That should be improved.
73 lines
1.9 KiB
Haskell
73 lines
1.9 KiB
Haskell
module Format where
|
|
|
|
import Base
|
|
import Juvix.Formatter
|
|
|
|
data PosTest = PosTest
|
|
{ _name :: String,
|
|
_dir :: Path Abs Dir,
|
|
_file :: Path Abs File,
|
|
_expectedFile :: Maybe (Path Abs File),
|
|
_force :: Bool
|
|
}
|
|
|
|
makeLenses ''PosTest
|
|
|
|
root :: Path Abs Dir
|
|
root = relToProject $(mkRelDir "tests/positive")
|
|
|
|
posTest :: String -> Path Rel Dir -> Path Rel File -> Maybe (Path Rel File) -> Bool -> PosTest
|
|
posTest _name rdir rfile efile _force =
|
|
let _dir = root <//> rdir
|
|
_file = _dir <//> rfile
|
|
_expectedFile = (_dir <//>) <$> efile
|
|
in PosTest {..}
|
|
|
|
testDescr :: PosTest -> TestDescr
|
|
testDescr PosTest {..} =
|
|
TestDescr
|
|
{ _testName = _name,
|
|
_testRoot = _dir,
|
|
_testAssertion = Steps $ \step -> do
|
|
entryPoint <- testDefaultEntryPointIO _dir _file
|
|
let maybeFile = entryPoint ^. entryPointModulePath
|
|
f <- fromMaybeM (assertFailure "Not a module") (return maybeFile)
|
|
|
|
original :: Text <- readFile f
|
|
|
|
step "Parsing & scoping"
|
|
PipelineResult {..} <- snd <$> testRunIO entryPoint upToScopingEntry
|
|
|
|
let formatted = formatScoperResult' _force original _pipelineResult
|
|
case _expectedFile of
|
|
Nothing -> do
|
|
step "Format"
|
|
assertEqDiffText "check: pretty . scope . parse = id" original formatted
|
|
Just eFile -> do
|
|
step "Checking against expected output file"
|
|
expFile :: Text <- readFile eFile
|
|
assertEqDiffText "Compare to expected output" formatted expFile
|
|
}
|
|
|
|
allTests :: TestTree
|
|
allTests =
|
|
testGroup
|
|
"Format positive tests"
|
|
(map (mkTest . testDescr) tests)
|
|
|
|
tests :: [PosTest]
|
|
tests =
|
|
[ posTest
|
|
"Format"
|
|
$(mkRelDir ".")
|
|
$(mkRelFile "Format.juvix")
|
|
Nothing
|
|
False,
|
|
posTest
|
|
"TrailingWhitespace"
|
|
$(mkRelDir ".")
|
|
$(mkRelFile "LocalModWithAxiom.juvix")
|
|
(Just $(mkRelFile "LocalModWithAxiom.juvix.formatted"))
|
|
True
|
|
]
|