Skip to content

Commit bc79d1d

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 bc79d1d

3 files changed

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