Skip to content

Commit 0fcd1f4

Browse files
Add Bun lockfile tactic implementation
Add support for parsing Bun's bun.lock (JSONC format) lockfiles. This includes: - BunProjectType registration in Types.hs - BunLock.hs with JSONC parser that handles trailing commas - Dependency graph builder with workspace support - Dev/production dependency labeling Ultraworked with [Sisyphus](https://github.com/code-yeongyu/oh-my-opencode) Co-authored-by: Sisyphus <clio-agent@sisyphuslabs.ai>
1 parent f2c5e94 commit 0fcd1f4

3 files changed

Lines changed: 338 additions & 0 deletions

File tree

spectrometer.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -480,6 +480,7 @@ library
480480
Strategy.Nim
481481
Strategy.Nim.NimbleLock
482482
Strategy.Node
483+
Strategy.Node.Bun.BunLock
483484
Strategy.Node.Errors
484485
Strategy.Node.Npm.PackageLock
485486
Strategy.Node.Npm.PackageLockV3
@@ -611,6 +612,7 @@ test-suite unit-tests
611612
App.Fossa.VSI.TypesSpec
612613
App.Fossa.VSIDepsSpec
613614
BerkeleyDB.BerkeleyDBSpec
615+
Bun.BunLockSpec
614616
BundlerSpec
615617
Cargo.CargoTomlSpec
616618
Cargo.MetadataSpec

src/Strategy/Node/Bun/BunLock.hs

Lines changed: 334 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,334 @@
1+
{-# LANGUAGE OverloadedRecordDot #-}
2+
3+
module Strategy.Node.Bun.BunLock (
4+
analyze,
5+
parseBunLock,
6+
buildGraph,
7+
BunLockFile (..),
8+
BunWorkspace (..),
9+
BunPackage (..),
10+
)
11+
where
12+
13+
import Control.Algebra (run)
14+
import Control.Effect.Diagnostics (Diagnostics, Has, context, fatal)
15+
import Data.Aeson (
16+
FromJSON (parseJSON),
17+
Result (..),
18+
Value (..),
19+
eitherDecodeStrict,
20+
fromJSON,
21+
withArray,
22+
withObject,
23+
(.!=),
24+
(.:),
25+
(.:?),
26+
)
27+
import Data.Aeson.KeyMap qualified as KM
28+
import Data.Foldable (for_)
29+
import Data.Map (Map)
30+
import Data.Map qualified as Map
31+
import Data.Set qualified as Set
32+
import Data.String.Conversion (encodeUtf8, toText)
33+
import Data.Text (Text)
34+
import Data.Text qualified as Text
35+
import Data.Vector qualified as V
36+
import DepTypes (DepEnvironment (..), DepType (NodeJSType), Dependency (..), VerConstraint (CEq))
37+
import Effect.Grapher (deep, direct, edge, evalGrapher)
38+
import Effect.ReadFS (ReadFS, ReadFSErr (FileParseError), readContentsText)
39+
import Graphing (Graphing)
40+
import Graphing qualified
41+
import Path (Abs, File, Path)
42+
43+
-- | Bun Lockfile structure
44+
-- Bun lockfile (bun.lock) is a JSONC format with the following shape:
45+
--
46+
-- @
47+
-- > {
48+
-- > "lockfileVersion": 1,
49+
-- > "workspaces": {
50+
-- > "": {
51+
-- > "name": "my-project",
52+
-- > "dependencies": {
53+
-- > "lodash": "^4.17.21"
54+
-- > },
55+
-- > "devDependencies": {
56+
-- > "typescript": "^5.0.0"
57+
-- > }
58+
-- > }
59+
-- > },
60+
-- > "packages": {
61+
-- > "lodash": ["lodash@4.17.21", "", {}, "sha512-xxx"],
62+
-- > "typescript": ["typescript@5.3.3", "", {"bin": {"tsc": "bin/tsc"}}, "sha512-yyy"]
63+
-- > }
64+
-- > }
65+
-- @
66+
--
67+
-- In this file:
68+
-- * `lockfileVersion`: Version of the lockfile format
69+
-- * `workspaces`: Map of workspace configurations
70+
-- * Key (e.g. "") refers to workspace path
71+
-- * `name`: Workspace name
72+
-- * `dependencies`: Direct production dependencies
73+
-- * `devDependencies`: Direct development dependencies
74+
-- * `packages`: Map of all resolved packages
75+
-- * Key: Package name (e.g. "lodash")
76+
-- * Value: Array [resolution, registry, info, integrity]
77+
-- - resolution: Package@version string
78+
-- - registry: Registry URL (empty string for npm)
79+
-- - info: Object with optional bin, scripts, etc.
80+
-- - integrity: SHA512 hash
81+
data BunLockFile = BunLockFile
82+
{ lockfileVersion :: Int
83+
, workspaces :: Map Text BunWorkspace
84+
, packages :: Map Text BunPackage
85+
}
86+
deriving (Show, Eq)
87+
88+
data BunWorkspace = BunWorkspace
89+
{ name :: Text
90+
, dependencies :: Map Text Text
91+
, devDependencies :: Map Text Text
92+
}
93+
deriving (Show, Eq, Ord)
94+
95+
data BunPackage = BunPackage
96+
{ resolution :: Text
97+
, registry :: Text
98+
, info :: Value
99+
, integrity :: Text
100+
}
101+
deriving (Show, Eq)
102+
103+
-- | FromJSON instance for BunLockFile
104+
-- Parses the top-level bun.lock structure
105+
instance FromJSON BunLockFile where
106+
parseJSON = withObject "BunLockFile" $ \obj ->
107+
BunLockFile
108+
<$> obj .: "lockfileVersion"
109+
<*> obj .:? "workspaces" .!= mempty
110+
<*> obj .:? "packages" .!= mempty
111+
112+
-- | FromJSON instance for BunWorkspace
113+
-- Parses workspace configuration
114+
instance FromJSON BunWorkspace where
115+
parseJSON = withObject "BunWorkspace" $ \obj ->
116+
BunWorkspace
117+
<$> obj .:? "name" .!= ""
118+
<*> obj .:? "dependencies" .!= mempty
119+
<*> obj .:? "devDependencies" .!= mempty
120+
121+
-- | FromJSON instance for BunPackage
122+
-- Parses the array format: [resolution, registry, info, integrity]
123+
instance FromJSON BunPackage where
124+
parseJSON = withArray "BunPackage" $ \arr -> do
125+
let vec = V.toList arr
126+
case vec of
127+
[resVal, regVal, infoVal, integrityVal] -> do
128+
res <- parseJSON resVal
129+
reg <- parseJSON regVal
130+
info' <- parseJSON infoVal
131+
integrity' <- parseJSON integrityVal
132+
pure $ BunPackage res reg info' integrity'
133+
_ -> fail $ "Expected array with 4 elements, got " ++ show (length vec)
134+
135+
-- | Parse a bun.lock file
136+
-- Bun lockfiles use JSONC format (JSON with comments)
137+
-- This function strips comments before parsing
138+
parseBunLock ::
139+
(Has ReadFS sig m, Has Diagnostics sig m) =>
140+
Path Abs File ->
141+
m BunLockFile
142+
parseBunLock file = context ("Parsing bun.lock file '" <> toText (show file) <> "'") $ do
143+
contents <- readContentsText file
144+
let stripped = stripJsoncComments contents
145+
bs = encodeUtf8 stripped
146+
case eitherDecodeStrict bs of
147+
Left err -> fatal $ FileParseError (show file) (toText err)
148+
Right lockFile -> pure lockFile
149+
150+
-- | Convert JSONC to valid JSON
151+
-- JSONC (JSON with Comments) allows:
152+
-- 1. Single-line comments starting with //
153+
-- 2. Trailing commas before } or ]
154+
--
155+
-- This function strips both to produce valid JSON
156+
stripJsoncComments :: Text -> Text
157+
stripJsoncComments input = removeTrailingCommas $ Text.unlines $ map processLine $ Text.lines input
158+
where
159+
-- Process a single line: strip comments
160+
processLine :: Text -> Text
161+
processLine line =
162+
let stripped = Text.stripStart line
163+
in if "//" `Text.isPrefixOf` stripped
164+
then ""
165+
else stripInlineComment line
166+
167+
-- Strip inline comments (// outside of strings)
168+
stripInlineComment :: Text -> Text
169+
stripInlineComment = go False
170+
where
171+
go :: Bool -> Text -> Text
172+
go _ t | Text.null t = t
173+
go inString t =
174+
case Text.uncons t of
175+
Nothing -> t
176+
Just ('"', rest)
177+
| not inString -> "\"" <> go True rest
178+
| otherwise -> "\"" <> go False rest
179+
Just ('\\', rest)
180+
| inString ->
181+
-- Escaped char in string, take next char too
182+
case Text.uncons rest of
183+
Just (c, rest') -> "\\" <> Text.singleton c <> go True rest'
184+
Nothing -> "\\"
185+
| otherwise -> "\\" <> go inString rest
186+
Just ('/', rest)
187+
| not inString ->
188+
case Text.uncons rest of
189+
Just ('/', _) -> "" -- Comment found, strip rest of line
190+
_ -> "/" <> go inString rest
191+
| otherwise -> "/" <> go inString rest
192+
Just (c, rest) -> Text.singleton c <> go inString rest
193+
194+
-- Remove trailing commas before } or ]
195+
-- Pattern: comma followed by optional whitespace then } or ]
196+
removeTrailingCommas :: Text -> Text
197+
removeTrailingCommas = go False
198+
where
199+
go :: Bool -> Text -> Text
200+
go _ t | Text.null t = t
201+
go inString t =
202+
case Text.uncons t of
203+
Nothing -> t
204+
Just ('"', rest)
205+
| not inString -> "\"" <> go True rest
206+
| otherwise -> "\"" <> go False rest
207+
Just ('\\', rest)
208+
| inString ->
209+
case Text.uncons rest of
210+
Just (c, rest') -> "\\" <> Text.singleton c <> go True rest'
211+
Nothing -> "\\"
212+
| otherwise -> "\\" <> go inString rest
213+
Just (',', rest)
214+
| not inString ->
215+
-- Check if this comma is followed by whitespace then } or ]
216+
let afterWs = Text.dropWhile (`elem` [' ', '\t', '\n', '\r']) rest
217+
in case Text.uncons afterWs of
218+
Just ('}', _) -> go False rest -- Skip the comma
219+
Just (']', _) -> go False rest -- Skip the comma
220+
_ -> "," <> go False rest -- Keep the comma
221+
| otherwise -> "," <> go inString rest
222+
Just (c, rest) -> Text.singleton c <> go inString rest
223+
224+
-- | Build a dependency graph from a parsed bun lockfile
225+
--
226+
-- The graph building process:
227+
-- 1. Iterate over all workspaces to mark direct dependencies
228+
-- 2. For each workspace dependency, look up the resolved package and mark as direct
229+
-- 3. Dev dependencies are marked with EnvDevelopment, production with EnvProduction
230+
-- 4. Iterate over all packages to add deep dependencies and edges
231+
-- 5. Extract transitive dependencies from package info and create edges
232+
buildGraph :: BunLockFile -> Graphing Dependency
233+
buildGraph lockFile = run . evalGrapher $ do
234+
-- Collect all dev dependency names from all workspaces
235+
let devDepNames = Set.fromList $ concatMap (Map.keys . devDependencies) (Map.elems lockFile.workspaces)
236+
237+
-- Process all workspaces for direct dependencies
238+
for_ (Map.elems lockFile.workspaces) $ \workspace -> do
239+
-- Production dependencies
240+
for_ (Map.keys workspace.dependencies) $ \depName -> do
241+
case Map.lookup depName lockFile.packages of
242+
Nothing -> pure ()
243+
Just pkg -> direct $ packageToDep pkg False
244+
245+
-- Dev dependencies
246+
for_ (Map.keys workspace.devDependencies) $ \depName -> do
247+
case Map.lookup depName lockFile.packages of
248+
Nothing -> pure ()
249+
Just pkg -> direct $ packageToDep pkg True
250+
251+
-- Process all packages for deep dependencies and edges
252+
for_ (Map.toList lockFile.packages) $ \(_, pkg) -> do
253+
let isDev = isDevDep devDepNames pkg
254+
parentDep = packageToDep pkg isDev
255+
256+
-- Add as deep dependency
257+
deep parentDep
258+
259+
-- Extract dependencies from info and create edges
260+
let pkgDeps = extractDependencies pkg.info
261+
for_ (Map.keys pkgDeps) $ \childName -> do
262+
case Map.lookup childName lockFile.packages of
263+
Nothing -> pure ()
264+
Just childPkg -> do
265+
let childDep = packageToDep childPkg (isDevDep devDepNames childPkg)
266+
edge parentDep childDep
267+
where
268+
-- Check if a package is a dev dependency based on the collected dev dep names
269+
isDevDep :: Set.Set Text -> BunPackage -> Bool
270+
isDevDep devNames pkg =
271+
let (name, _) = parseResolution pkg.resolution
272+
in Set.member name devNames
273+
274+
-- | Convert a BunPackage to a Dependency
275+
packageToDep :: BunPackage -> Bool -> Dependency
276+
packageToDep pkg isDev =
277+
let (name, version) = parseResolution pkg.resolution
278+
env = if isDev then EnvDevelopment else EnvProduction
279+
in Dependency
280+
{ dependencyType = NodeJSType
281+
, dependencyName = name
282+
, dependencyVersion = Just (CEq version)
283+
, dependencyLocations = mempty
284+
, dependencyEnvironments = Set.singleton env
285+
, dependencyTags = mempty
286+
}
287+
288+
-- | Parse resolution string "name@version" or "@scope/name@version"
289+
--
290+
-- >>> parseResolution "lodash@4.17.21"
291+
-- ("lodash", "4.17.21")
292+
--
293+
-- >>> parseResolution "@angular/core@16.0.0"
294+
-- ("@angular/core", "16.0.0")
295+
parseResolution :: Text -> (Text, Text)
296+
parseResolution res
297+
| "@" `Text.isPrefixOf` res =
298+
-- Scoped package: @scope/name@version
299+
let withoutAt = Text.drop 1 res
300+
(scopeAndName, rest) = Text.breakOn "@" withoutAt
301+
in ("@" <> scopeAndName, Text.drop 1 rest)
302+
| otherwise =
303+
-- Regular package: name@version
304+
let (name, rest) = Text.breakOn "@" res
305+
in (name, Text.drop 1 rest)
306+
307+
-- | Extract dependencies map from package info Value
308+
-- The info object may contain a "dependencies" key with a map of dep name to version spec
309+
extractDependencies :: Value -> Map Text Text
310+
extractDependencies (Object obj) =
311+
case KM.lookup "dependencies" obj of
312+
Just depsVal ->
313+
case fromJSON depsVal of
314+
Success deps -> deps
315+
Error _ -> mempty
316+
Nothing -> mempty
317+
extractDependencies _ = mempty
318+
319+
-- | Filter out workspace packages from the dependency graph
320+
-- Workspace packages are internal packages in a monorepo and should not be included
321+
-- in the final dependency graph
322+
filterWorkspaces :: BunLockFile -> Graphing Dependency -> Graphing Dependency
323+
filterWorkspaces lockFile =
324+
let workspaceNames = Set.fromList $ map name (Map.elems lockFile.workspaces)
325+
in Graphing.shrink (\dep -> not (Set.member (dependencyName dep) workspaceNames))
326+
327+
-- | Analyze a bun.lock file and produce a dependency graph
328+
analyze ::
329+
(Has ReadFS sig m, Has Diagnostics sig m) =>
330+
Path Abs File ->
331+
m (Graphing Dependency)
332+
analyze file = do
333+
lockfile <- parseBunLock file
334+
pure $ filterWorkspaces lockfile $ buildGraph lockfile

src/Types.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,6 +67,7 @@ data DiscoveredProjectType
6767
= AlpineDatabaseProjectType
6868
| BerkeleyDBProjectType
6969
| BinaryDepsProjectType
70+
| BunProjectType
7071
| BundlerProjectType
7172
| CabalProjectType
7273
| CargoProjectType
@@ -119,6 +120,7 @@ projectTypeToText = \case
119120
AlpineDatabaseProjectType -> "apkdb"
120121
BerkeleyDBProjectType -> "berkeleydb"
121122
BinaryDepsProjectType -> "binary-deps"
123+
BunProjectType -> "bun"
122124
BundlerProjectType -> "bundler"
123125
CabalProjectType -> "cabal"
124126
CargoProjectType -> "cargo"

0 commit comments

Comments
 (0)