Skip to content

Commit

Permalink
Add build dependencies to package pages
Browse files Browse the repository at this point in the history 
Closes #59
  • Loading branch information
@andreabedini
andreabedini committed May 29, 2023
1 parent eb0e97d commit 1f899fe
Show file tree
Hide file tree
Showing 3 changed files with 78 additions and 64 deletions.
71 changes: 32 additions & 39 deletions app/Distribution/Aeson.hs
View file
Expand Up @@ -12,11 +12,12 @@
module Distribution.Aeson where

import Data.Aeson
import Data.Aeson.Key (fromString)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types
import Data.Bifunctor (second)
import Data.List (foldl1')
import Data.String (fromString)
import Distribution.CabalSpecVersion
import Distribution.Compat.Lens hiding ((.=))
import Distribution.Compat.Newtype
Expand Down Expand Up @@ -192,7 +193,7 @@ instance FieldGrammar ToJSON JSONFieldGrammar where

prefixedFields :: FieldName -> ALens' s [(String, String)] -> JSONFieldGrammar s [(String, String)]
prefixedFields _fnPfx l = JsonFG $ \_v _cs s ->
[fromString n .= v | (n, v) <- aview l s]
[Key.fromString n .= v | (n, v) <- aview l s]

knownField :: FieldName -> JSONFieldGrammar s ()
knownField _ = pure ()
Expand All @@ -213,8 +214,8 @@ jsonField :: [Condition ConfVar] -> FieldName -> Value -> [Pair]
jsonField cs fn v
| v == emptyArray = mempty
| v == emptyString = mempty
| null cs = [fromString (fromUTF8BS fn) .= v]
| otherwise = [fromString (fromUTF8BS fn) .= v']
| null cs = [Key.fromString (fromUTF8BS fn) .= v]
| otherwise = [Key.fromString (fromUTF8BS fn) .= v']
where
v' = object ["if" .= toJSON (foldl1' CAnd cs), "then" .= v]

Expand All @@ -223,12 +224,7 @@ jsonField cs fn v
emptyString = String ""

jsonGenericPackageDescription :: GenericPackageDescription -> Value
jsonGenericPackageDescription gpd = jsonGenericPackageDescription' v gpd
where
v = specVersion $ packageDescription gpd

jsonGenericPackageDescription' :: CabalSpecVersion -> GenericPackageDescription -> Value
jsonGenericPackageDescription' v gpd =
jsonGenericPackageDescription gpd =
object $
concat
[ jsonPackageDescription v (packageDescription gpd),
Expand All @@ -241,6 +237,8 @@ jsonGenericPackageDescription' v gpd =
jsonCondTestSuites v (condTestSuites gpd),
jsonCondBenchmarks v (condBenchmarks gpd)
]
where
v = specVersion $ packageDescription gpd

jsonPackageDescription :: CabalSpecVersion -> PackageDescription -> [Pair]
jsonPackageDescription v pd =
Expand Down Expand Up @@ -272,7 +270,7 @@ jsonGenPackageFlags v flags
where
flags' =
object
[ fromString (unFlagName name) .= object (jsonFieldGrammar v [] (flagFieldGrammar name) flag)
[ Key.fromString (unFlagName name) .= object (jsonFieldGrammar v [] (flagFieldGrammar name) flag)
| flag@(MkPackageFlag name _ _ _) <- flags
]

Expand All @@ -288,61 +286,56 @@ jsonCondSubLibraries v libs
| otherwise = ["sub-libraries" .= libs']
where
libs' =
object
[ fromString (unUnqualComponentName n)
.= jsonCondTree2 v (libraryFieldGrammar $ LSubLibName n) condTree
| (n, condTree) <- libs
]
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
jsonCondTree2 v (libraryFieldGrammar $ LSubLibName n) condTree
| (n, condTree) <- libs
]

jsonCondForeignLibs :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [Pair]
jsonCondForeignLibs v flibs
| null flibs = mempty
| otherwise = ["foreign-libraries" .= flibs']
where
flibs' =
object
[ fromString (unUnqualComponentName n)
.= jsonCondTree2 v (foreignLibFieldGrammar n) condTree
| (n, condTree) <- flibs
]
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
jsonCondTree2 v (foreignLibFieldGrammar n) condTree
| (n, condTree) <- flibs
]

jsonCondExecutables :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [Pair]
jsonCondExecutables v exes
| null exes = mempty
| otherwise = ["executables" .= exes']
where
exes' =
object
[ fromString (unUnqualComponentName n)
.= jsonCondTree2 v (executableFieldGrammar n) condTree
| (n, condTree) <- exes
]
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
jsonCondTree2 v (executableFieldGrammar n) condTree
| (n, condTree) <- exes
]

jsonCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [Pair]
jsonCondTestSuites v suites
| null suites = mempty
| otherwise = ["test-suites" .= suites']
where
suites' =
object
[ fromString (unUnqualComponentName n)
.= jsonCondTree2 v testSuiteFieldGrammar (fmap unvalidateTestSuite condTree)
| (n, condTree) <- suites
]
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
jsonCondTree2 v testSuiteFieldGrammar (fmap unvalidateTestSuite condTree)
| (n, condTree) <- suites
]

jsonCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [Pair]
jsonCondBenchmarks v suites
| null suites = mempty
| otherwise = ["benchmarks" .= suites']
where
suites' =
object
[ fromString (unUnqualComponentName n)
.= jsonCondTree2 v benchmarkFieldGrammar (fmap unvalidateBenchmark condTree)
| (n, condTree) <- suites
]
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
jsonCondTree2 v benchmarkFieldGrammar (fmap unvalidateBenchmark condTree)
| (n, condTree) <- suites
]

jsonCondTree2 :: CabalSpecVersion -> JSONFieldGrammar' s -> CondTree ConfVar [Dependency] s -> Value
jsonCondTree2 :: CabalSpecVersion -> JSONFieldGrammar' s -> CondTree ConfVar [Dependency] s -> KeyMap.KeyMap Value
jsonCondTree2 v grammar = merge . go []
where
go cs (CondNode it _ ifs) =
Expand All @@ -353,5 +346,5 @@ jsonCondTree2 v grammar = merge . go []
jsonIf cs (CondBranch c thenTree (Just elseTree)) =
go (c : cs) thenTree ++ go (CNot c : cs) elseTree

merge :: [Pair] -> Value
merge = Object . fmap toJSON . KeyMap.fromListWith (++) . map (second (: []))
merge :: [Pair] -> KeyMap.KeyMap Value
merge = fmap toJSON . KeyMap.fromListWith (<>) . map (second (: []))
26 changes: 14 additions & 12 deletions app/Foliage/Pages.hs
View file
Expand Up @@ -143,18 +143,20 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions =
& sortOn (Down . allPackageVersionsPageEntryTimestamp)

makePackageVersionPage :: FilePath -> PreparedPackageVersion -> Action ()
makePackageVersionPage outputDir PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, pkgDesc, cabalFileRevisions, pkgVersionIsDeprecated} = do
traced ("webpages / package / " ++ prettyShow pkgId) $ do
IO.createDirectoryIfMissing True (outputDir </> "package" </> prettyShow pkgId)
TL.writeFile (outputDir </> "package" </> prettyShow pkgId </> "index.html") $
renderMustache packageVersionPageTemplate $
object
[ "pkgVersionSource" .= pkgVersionSource,
"cabalFileRevisions" .= map fst cabalFileRevisions,
"pkgDesc" .= jsonGenericPackageDescription pkgDesc,
"pkgTimestamp" .= pkgTimestamp,
"pkgVersionDeprecated" .= pkgVersionIsDeprecated
]
makePackageVersionPage
outputDir
PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, pkgDesc, cabalFileRevisions, pkgVersionIsDeprecated} =
traced ("webpages / package / " ++ prettyShow pkgId) $ do
IO.createDirectoryIfMissing True (outputDir </> "package" </> prettyShow pkgId)
TL.writeFile (outputDir </> "package" </> prettyShow pkgId </> "index.html") $
renderMustache packageVersionPageTemplate $
object
[ "pkgVersionSource" .= pkgVersionSource,
"cabalFileRevisions" .= map fst cabalFileRevisions,
"pkgDesc" .= jsonGenericPackageDescription pkgDesc,
"pkgTimestamp" .= pkgTimestamp,
"pkgVersionDeprecated" .= pkgVersionIsDeprecated
]

indexPageTemplate :: Template
indexPageTemplate = $(compileMustacheDir "index" "templates")
Expand Down
45 changes: 32 additions & 13 deletions templates/packageVersion.mustache
View file
Expand Up @@ -4,18 +4,13 @@
<!-- Required meta tags -->
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">

<!-- Bootstrap CSS -->
<link href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">

<title>
{{#pkgDesc}}
{{name}}-{{version}}
{{/pkgDesc}}
{{pkgDesc.name}}-{{pkgDesc.version}}
</title>
</head>
<body>
{{#pkgDesc}}
<div class="container px-4 py-5">
<ul class="nav">
<li class="nav-item">
Expand All @@ -29,24 +24,23 @@
</li>
</ul>
<h1 class="py-5">
{{name}}-{{version}}
{{pkgDesc.name}}-{{pkgDesc.version}}
</h1>
<dl class="row class="px-4 py-5">
{{#pkgVersionDeprecated}}
<dt class="col-sm-3"><span class="badge bg-danger" style="font-size: 1em">Deprecated</span></dt>
<dd></dd>
{{/pkgVersionDeprecated}}
<dt class="col-sm-3">Synopsis</dt>
<dd class="col-sm-9"><p>{{synopsis}}</p></dd>
<dd class="col-sm-9"><p>{{pkgDesc.synopsis}}</p></dd>
<dt class="col-sm-3">Description</dt>
<dd class="col-sm-9"><p>{{description}}</p></dd>
<dd class="col-sm-9"><p>{{pkgDesc.description}}</p></dd>
<dt class="col-sm-3">Author</dt>
<dd class="col-sm-9"><p>{{author}}</p></dd>
<dd class="col-sm-9"><p>{{pkgDesc.author}}</p></dd>
<dt class="col-sm-3">Maintainer</dt>
<dd class="col-sm-9"><p>{{maintainer}}</p></dd>
<dd class="col-sm-9"><p>{{pkgDesc.maintainer}}</p></dd>
<dt class="col-sm-3">License</dt>
<dd class="col-sm-9"><p>{{license}}</p></dd>
{{/pkgDesc}}
<dd class="col-sm-9"><p>{{pkgDesc.license}}</p></dd>
{{#pkgVersionSource}}
<dt class="col-sm-3">Source</dt>
<dd class="col-sm-9">
Expand All @@ -66,6 +60,31 @@
<p>None</p>
{{/cabalFileRevisions}}
</dd>
{{#pkgDesc.library}}
<dt class="col-sm-3">Dependencies</dt>
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
{{/pkgDesc.library}}
</dd>
{{#pkgDesc.sub-libraries}}
<dt class="col-sm-3">sub-library {{name}}</dt>
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
{{/pkgDesc.sub-libraries}}
{{#pkgDesc.foreign-libraries}}
<dt class="col-sm-3">foreign-library {{name}}</dt>
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
{{/pkgDesc.foreign-libraries}}
{{#pkgDesc.executables}}
<dt class="col-sm-3">executable {{name}}</dt>
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
{{/pkgDesc.executables}}
{{#pkgDesc.test-suites}}
<dt class="col-sm-3">test-suite {{name}}</dt>
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
{{/pkgDesc.test-suites}}
{{#pkgDesc.benchmarks}}
<dt class="col-sm-3">benchmark {{name}}</dt>
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
{{/pkgDesc.benchmarks}}
</dl>
</div>
</body>
Expand Down

0 comments on commit 1f899fe

Please sign in to comment.