From 56f8b81838657d4f0c3bb0ef928c0b8c82cdc1fc Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Fri, 26 May 2023 21:38:46 +0800 Subject: [PATCH] Display conditionals correctly --- app/Distribution/Aeson.hs | 346 +++++++++++++----------- app/Foliage/Pages.hs | 40 +-- foliage.cabal | 3 +- templates/cond-tree-dependency.mustache | 9 - templates/dependencies.mustache | 17 ++ templates/packageVersion.mustache | 27 +- 6 files changed, 229 insertions(+), 213 deletions(-) delete mode 100644 templates/cond-tree-dependency.mustache create mode 100644 templates/dependencies.mustache diff --git a/app/Distribution/Aeson.hs b/app/Distribution/Aeson.hs index 8d6c1ea..b6a65b7 100644 --- a/app/Distribution/Aeson.hs +++ b/app/Distribution/Aeson.hs @@ -3,8 +3,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -13,8 +15,11 @@ module Distribution.Aeson where import Data.Aeson import Data.Aeson.Key qualified as Key +import Data.Aeson.KeyMap qualified as KeyMap import Data.Aeson.Types +import Data.List (foldl1') import Data.List.NonEmpty qualified as NE +import Data.Vector qualified as V import Distribution.CabalSpecVersion import Distribution.Compat.Lens hiding ((.=)) import Distribution.Compat.Newtype @@ -25,7 +30,6 @@ import Distribution.ModuleName hiding (fromString) import Distribution.PackageDescription import Distribution.PackageDescription.FieldGrammar import Distribution.Pretty -import Distribution.System import Distribution.Types.Version import Distribution.Types.VersionRange import Distribution.Utils.Generic (fromUTF8BS) @@ -33,166 +37,97 @@ import Distribution.Utils.Path import Distribution.Utils.ShortText qualified as ST import Language.Haskell.Extension -newtype ViaPretty a = ViaPretty a - -instance Pretty a => ToJSON (ViaPretty a) where - toJSON (ViaPretty a) = toJSON $ prettyShow a - -newtype ViaUnpack a = ViaUnpack a - -instance (ToJSON o, Newtype o n) => ToJSON (ViaUnpack n) where - toJSON (ViaUnpack n) = toJSON $ unpack n - -deriving via String instance ToJSON Token - -deriving via String instance ToJSON Token' - -deriving via String instance ToJSON FilePathNT - -deriving via String instance ToJSON CompatFilePath - -deriving via ViaUnpack CompatLicenseFile instance ToJSON CompatLicenseFile - -deriving via (ViaPretty VersionRange) instance ToJSON VersionRange - -deriving via ViaUnpack TestedWith instance ToJSON TestedWith - -deriving via (ViaPretty CompilerFlavor) instance ToJSON CompilerFlavor - -deriving via (ViaPretty SpecVersion) instance ToJSON SpecVersion - -deriving via (ViaPretty SpecLicense) instance ToJSON SpecLicense - -deriving via (ViaUnpack (List sep b a)) instance ToJSON a => ToJSON (List sep b a) - -deriving via (ViaPretty (SymbolicPath from to)) instance ToJSON (SymbolicPath from to) - -deriving via (ViaPretty BuildType) instance ToJSON BuildType - -deriving via (ViaPretty PackageName) instance ToJSON PackageName - -deriving via (ViaPretty Version) instance ToJSON Version - -instance ToJSON RepoType - -instance ToJSON KnownRepoType - -deriving via (ViaPretty Extension) instance ToJSON Extension - -deriving via (ViaPretty Language) instance ToJSON Language - -deriving via (ViaUnpack (MQuoted a)) instance ToJSON a => ToJSON (MQuoted a) - -deriving via (ViaPretty Dependency) instance ToJSON Dependency - -deriving via (ViaPretty BenchmarkType) instance ToJSON BenchmarkType - -deriving via (ViaPretty ForeignLibType) instance ToJSON ForeignLibType - -deriving via (ViaPretty TestType) instance ToJSON TestType - -deriving via (ViaPretty ExecutableScope) instance ToJSON ExecutableScope - -deriving via (ViaPretty ForeignLibOption) instance ToJSON ForeignLibOption - -deriving via (ViaPretty LibVersionInfo) instance ToJSON LibVersionInfo - -deriving via (ViaPretty ModuleName) instance ToJSON ModuleName - -deriving via (ViaPretty ModuleReexport) instance ToJSON ModuleReexport - -deriving via (ViaPretty Mixin) instance ToJSON Mixin - -deriving via (ViaPretty PkgconfigDependency) instance ToJSON PkgconfigDependency - -deriving via (ViaPretty ExeDependency) instance ToJSON ExeDependency - -deriving via (ViaPretty LegacyExeDependency) instance ToJSON LegacyExeDependency - -deriving via (ViaPretty LibraryVisibility) instance ToJSON LibraryVisibility - -deriving via (ViaPretty FlagName) instance ToJSON FlagName - -deriving via (ViaPretty Arch) instance ToJSON Arch - -deriving via (ViaPretty OS) instance ToJSON OS - -instance ToJSON ConfVar where - toJSON (OS os) = object ["os" .= os] - toJSON (Arch arch) = object ["arcg" .= arch] - toJSON (PackageFlag flag) = object ["os" .= flag] - toJSON (Impl compiler version) - | isAnyVersion version = object ["compiler" .= compiler] - | otherwise = object ["compiler" .= compiler, "version" .= version] - -instance ToJSON c => ToJSON (Condition c) where - toJSON (Var v) = toJSON v - toJSON (Lit b) = toJSON b - toJSON (CNot c) = object ["not" .= c] - toJSON (COr l r) = object ["or" .= [l, r]] - toJSON (CAnd l r) = object ["and" .= [l, r]] +-- Note: this JSONFieldGrammar is not quite general purpose. +-- +-- To help with the rendering of conditional dependencies, here we "push" +-- all the conditionals down. +-- So while the build-dependencies in a GenericPackageDescription could +-- be represented as: +-- +-- { +-- "build-depends": ["a", "b", "c"], +-- "conditionals": [{ +-- "if": {"os": "darwin"}, +-- "then": { +-- "build-depends": ["d"] +-- } +-- }] +-- } +-- +-- we decide to represent them as +-- +-- { +-- "build-depends": [ +-- "a", +-- "b", +-- "c", +-- { "if": "os(darwin)", "then": "d" } +-- ] +-- } +-- +-- Note: we also pretty-print the condition. newtype JSONFieldGrammar s a = JsonFG - { fieldGrammarJSON :: CabalSpecVersion -> s -> [Pair] + { runJSONFieldGrammar :: CabalSpecVersion -> [Condition ConfVar] -> s -> [Pair] } deriving (Functor) type JSONFieldGrammar' s = JSONFieldGrammar s s -jsonFieldGrammar :: CabalSpecVersion -> JSONFieldGrammar s a -> s -> [Pair] -jsonFieldGrammar v fg = fieldGrammarJSON fg v +jsonFieldGrammar :: CabalSpecVersion -> [Condition ConfVar] -> JSONFieldGrammar s a -> s -> [Pair] +jsonFieldGrammar v cs fg = runJSONFieldGrammar fg v cs instance Applicative (JSONFieldGrammar s) where - pure _ = JsonFG (\_ _ -> mempty) - JsonFG f <*> JsonFG x = JsonFG (\v s -> f v s <> x v s) + pure _ = JsonFG (\_ _ _ -> mempty) + JsonFG f <*> JsonFG x = JsonFG (\v cs s -> f v cs s <> x v cs s) instance FieldGrammar ToJSON JSONFieldGrammar where blurFieldGrammar :: ALens' a b -> JSONFieldGrammar b d -> JSONFieldGrammar a d - blurFieldGrammar f (JsonFG fg) = JsonFG $ \v -> - fg v . aview f + blurFieldGrammar f (JsonFG fg) = JsonFG $ \v cs -> + fg v cs . aview f uniqueFieldAla :: (ToJSON b, Newtype a b) => FieldName -> (a -> b) -> ALens' s a -> JSONFieldGrammar s a - uniqueFieldAla fn _pack l = JsonFG $ \_v -> - jsonField fn . toJSON . pack' _pack . aview l + uniqueFieldAla fn _pack l = JsonFG $ \_v cs -> + jsonField cs fn . toJSON . pack' _pack . aview l booleanFieldDef :: FieldName -> ALens' s Bool -> Bool -> JSONFieldGrammar s Bool - booleanFieldDef fn l def = JsonFG $ \_v s -> + booleanFieldDef fn l def = JsonFG $ \_v cs s -> let b = aview l s in if b == def then mempty - else jsonField fn (toJSON b) + else jsonField cs fn (toJSON b) optionalFieldAla :: (ToJSON b, Newtype a b) => FieldName -> (a -> b) -> ALens' s (Maybe a) -> JSONFieldGrammar s (Maybe a) - optionalFieldAla fn _pack l = JsonFG $ \_ s -> + optionalFieldAla fn _pack l = JsonFG $ \_ cs s -> case aview l s of Nothing -> mempty - Just a -> jsonField fn (toJSON (pack' _pack a)) + Just a -> jsonField cs fn (toJSON (pack' _pack a)) optionalFieldDefAla :: (ToJSON b, Newtype a b, Eq a) => FieldName -> (a -> b) -> ALens' s a -> a -> JSONFieldGrammar s a - optionalFieldDefAla fn _pack l def = JsonFG $ \_ s -> + optionalFieldDefAla fn _pack l def = JsonFG $ \_ cs s -> let x = aview l s in if x == def then mempty - else jsonField fn (toJSON (pack' _pack x)) + else jsonField cs fn (toJSON (pack' _pack x)) freeTextField :: FieldName -> ALens' s (Maybe String) -> JSONFieldGrammar s (Maybe String) - freeTextField fn l = JsonFG $ \_v s -> - maybe mempty (jsonField fn . toJSON) (aview l s) + freeTextField fn l = JsonFG $ \_v cs s -> + maybe mempty (jsonField cs fn . toJSON) (aview l s) freeTextFieldDef :: FieldName -> ALens' s String -> JSONFieldGrammar s String - freeTextFieldDef fn l = JsonFG $ \_v -> - jsonField fn . toJSON . aview l + freeTextFieldDef fn l = JsonFG $ \_v cs -> + jsonField cs fn . toJSON . aview l freeTextFieldDefST :: FieldName -> ALens' s ST.ShortText -> JSONFieldGrammar s ST.ShortText freeTextFieldDefST = defaultFreeTextFieldDefST monoidalFieldAla :: (ToJSON b, Monoid a, Newtype a b) => FieldName -> (a -> b) -> ALens' s a -> JSONFieldGrammar s a - monoidalFieldAla fn _pack l = JsonFG $ \_v -> - jsonField fn . toJSON . pack' _pack . aview l + monoidalFieldAla fn _pack l = JsonFG $ \_v cs -> + jsonField cs fn . toJSON . pack' _pack . aview l prefixedFields :: FieldName -> ALens' s [(String, String)] -> JSONFieldGrammar s [(String, String)] - prefixedFields fnPfx l = JsonFG $ \_v s -> - [Key.fromString (fromUTF8BS fnPfx <> n) .= v | (n, v) <- aview l s] + prefixedFields _fnPfx l = JsonFG $ \_v _cs s -> + [Key.fromString n .= v | (n, v) <- aview l s] knownField :: FieldName -> JSONFieldGrammar s () knownField _ = pure () @@ -209,21 +144,30 @@ instance FieldGrammar ToJSON JSONFieldGrammar where hiddenField _ = JsonFG (const mempty) -jsonField :: FieldName -> Value -> [Pair] -jsonField fn v +jsonField :: [Condition ConfVar] -> FieldName -> Value -> [Pair] +jsonField cs fn v | v == emptyArray = mempty | v == emptyString = mempty - | otherwise = [Key.fromString (fromUTF8BS fn) .= v] + | null cs = [Key.fromString (fromUTF8BS fn) .= v] + | otherwise = [Key.fromString (fromUTF8BS fn) .= v'] where + v' = object ["if" .= showCondition (foldl1' cAnd cs), "then" .= v] + -- Should be added to aeson emptyString :: Value emptyString = String "" jsonGenericPackageDescription :: GenericPackageDescription -> Value -jsonGenericPackageDescription gpd = +jsonGenericPackageDescription gpd = jsonGenericPackageDescription' v gpd + where + v = specVersion $ packageDescription gpd + +jsonGenericPackageDescription' :: CabalSpecVersion -> GenericPackageDescription -> Value +jsonGenericPackageDescription' v gpd = object $ concat [ jsonPackageDescription v (packageDescription gpd), + jsonSetupBuildInfo v (setupBuildInfo (packageDescription gpd)), jsonGenPackageFlags v (genPackageFlags gpd), jsonCondLibrary v (condLibrary gpd), jsonCondSubLibraries v (condSubLibraries gpd), @@ -232,12 +176,10 @@ jsonGenericPackageDescription gpd = jsonCondTestSuites v (condTestSuites gpd), jsonCondBenchmarks v (condBenchmarks gpd) ] - where - v = specVersion $ packageDescription gpd jsonPackageDescription :: CabalSpecVersion -> PackageDescription -> [Pair] jsonPackageDescription v pd@PackageDescription {sourceRepos, setupBuildInfo} = - jsonFieldGrammar v packageDescriptionFieldGrammar pd + jsonFieldGrammar v [] packageDescriptionFieldGrammar pd <> jsonSourceRepos v sourceRepos <> jsonSetupBuildInfo v setupBuildInfo @@ -245,21 +187,21 @@ jsonSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [Pair] jsonSourceRepos v = concatMap (\neRepos -> ["source-repository" .= NE.map (jsonSourceRepo v) neRepos]) . NE.nonEmpty -jsonSetupBuildInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [Pair] -jsonSetupBuildInfo v = - concatMap (\sbi -> ["custom-setup" .= jsonFieldGrammar v (setupBInfoFieldGrammar False) sbi]) - jsonSourceRepo :: CabalSpecVersion -> SourceRepo -> Value jsonSourceRepo v repo@SourceRepo {repoKind} = - object $ jsonFieldGrammar v (sourceRepoFieldGrammar repoKind) repo + object $ jsonFieldGrammar v [] (sourceRepoFieldGrammar repoKind) repo + +jsonSetupBuildInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [Pair] +jsonSetupBuildInfo v = + concatMap (\sbi -> ["custom-setup" .= jsonFieldGrammar v [] (setupBInfoFieldGrammar False) sbi]) jsonGenPackageFlags :: CabalSpecVersion -> [PackageFlag] -> [Pair] jsonGenPackageFlags v = - concatMap (\neFlags -> ["flags" .= NE.map (jsonFlag v) neFlags]) . NE.nonEmpty + concatMap (\neFlags -> ["flags" .= object (NE.toList $ NE.map (jsonFlag v) neFlags)]) . NE.nonEmpty -jsonFlag :: CabalSpecVersion -> PackageFlag -> Value +jsonFlag :: CabalSpecVersion -> PackageFlag -> Pair jsonFlag v flag@(MkPackageFlag name _ _ _) = - object [Key.fromString (unFlagName name) .= jsonFieldGrammar v (flagFieldGrammar name) flag] + Key.fromString (unFlagName name) .= object (jsonFieldGrammar v [] (flagFieldGrammar name) flag) jsonCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [Pair] jsonCondLibrary v = @@ -310,27 +252,117 @@ jsonCondBenchmark v (n, condTree) = withName (unUnqualComponentName n) $ jsonCondTree v benchmarkFieldGrammar (fmap unvalidateBenchmark condTree) -jsonCondTree :: CabalSpecVersion -> JSONFieldGrammar' s -> CondTree ConfVar [Dependency] s -> [Pair] -jsonCondTree v grammar = goNode +jsonCondTree :: forall s. CabalSpecVersion -> JSONFieldGrammar' s -> CondTree ConfVar [Dependency] s -> [Pair] +jsonCondTree v grammar = go [] where - goNode (CondNode it _ ifs) = - jsonFieldGrammar v grammar it ++ concatMap goBranch ifs + go cs (CondNode it _ ifs) = + KeyMap.toList $ foldr merge (KeyMap.fromList $ jsonFieldGrammar v cs grammar it) $ concatMap (jsonIf cs) ifs - goBranch (CondBranch c ifTrue Nothing) = - [ "if" - .= object - [ "cond" .= c, - "then" .= object (jsonCondTree v grammar ifTrue) - ] - ] - goBranch (CondBranch c ifTrue (Just ifFalse)) = - [ "if" - .= object - [ "cond" .= c, - "then" .= object (jsonCondTree v grammar ifTrue), - "else" .= object (jsonCondTree v grammar ifFalse) - ] - ] + jsonIf :: [Condition ConfVar] -> CondBranch ConfVar c s -> [Pair] + jsonIf cs (CondBranch c thenTree Nothing) = + go (c : cs) thenTree + jsonIf cs (CondBranch c thenTree (Just elseTree)) = + go (c : cs) thenTree ++ go (cNot c : cs) elseTree -withName :: ToJSON v => v -> [Pair] -> Value + merge :: Pair -> KeyMap.KeyMap Value -> KeyMap.KeyMap Value + merge = uncurry $ KeyMap.insertWith $ \new -> + \case + (Array a) -> Array (a `V.snoc` new) + old -> Array (V.fromList [old, new]) + +withName :: (ToJSON v) => v -> [Pair] -> Value withName n s = object $ ("name" .= n) : s + +showCondition :: Condition ConfVar -> String +showCondition (Var x) = showConfVar x +showCondition (Lit b) = show b +showCondition (CNot c) = "!" <> showCondition c +showCondition (COr c1 c2) = "(" <> unwords [showCondition c1, "||", showCondition c2] <> ")" +showCondition (CAnd c1 c2) = "(" <> unwords [showCondition c1, "&&", showCondition c2] <> ")" + +showConfVar :: ConfVar -> String +showConfVar (OS os) = "os(" <> prettyShow os <> ")" +showConfVar (Arch arch) = "arch(" <> prettyShow arch <> ")" +showConfVar (PackageFlag name) = "flag(" <> unFlagName name <> ")" +showConfVar (Impl c v) = "impl(" <> prettyShow c <> " " <> prettyShow v <> ")" + +showIfCondition :: Condition ConfVar -> String +showIfCondition c = "if " <> showCondition c + +newtype ViaPretty a = ViaPretty a + +instance (Pretty a) => ToJSON (ViaPretty a) where + toJSON (ViaPretty a) = toJSON $ prettyShow a + +newtype ViaUnpack a = ViaUnpack a + +instance (ToJSON o, Newtype o n) => ToJSON (ViaUnpack n) where + toJSON (ViaUnpack n) = toJSON $ unpack n + +deriving via String instance ToJSON Token + +deriving via String instance ToJSON Token' + +deriving via String instance ToJSON FilePathNT + +deriving via String instance ToJSON CompatFilePath + +deriving via ViaUnpack CompatLicenseFile instance ToJSON CompatLicenseFile + +deriving via (ViaPretty VersionRange) instance ToJSON VersionRange + +deriving via ViaUnpack TestedWith instance ToJSON TestedWith + +deriving via (ViaPretty CompilerFlavor) instance ToJSON CompilerFlavor + +deriving via (ViaPretty SpecVersion) instance ToJSON SpecVersion + +deriving via (ViaPretty SpecLicense) instance ToJSON SpecLicense + +deriving via (ViaUnpack (List sep b a)) instance (ToJSON a) => ToJSON (List sep b a) + +deriving via (ViaPretty (SymbolicPath from to)) instance ToJSON (SymbolicPath from to) + +deriving via (ViaPretty BuildType) instance ToJSON BuildType + +deriving via (ViaPretty PackageName) instance ToJSON PackageName + +deriving via (ViaPretty Version) instance ToJSON Version + +instance ToJSON RepoType + +instance ToJSON KnownRepoType + +deriving via (ViaPretty Extension) instance ToJSON Extension + +deriving via (ViaPretty Language) instance ToJSON Language + +deriving via (ViaUnpack (MQuoted a)) instance (ToJSON a) => ToJSON (MQuoted a) + +deriving via (ViaPretty Dependency) instance ToJSON Dependency + +deriving via (ViaPretty BenchmarkType) instance ToJSON BenchmarkType + +deriving via (ViaPretty ForeignLibType) instance ToJSON ForeignLibType + +deriving via (ViaPretty TestType) instance ToJSON TestType + +deriving via (ViaPretty ExecutableScope) instance ToJSON ExecutableScope + +deriving via (ViaPretty ForeignLibOption) instance ToJSON ForeignLibOption + +deriving via (ViaPretty LibVersionInfo) instance ToJSON LibVersionInfo + +deriving via (ViaPretty ModuleName) instance ToJSON ModuleName + +deriving via (ViaPretty ModuleReexport) instance ToJSON ModuleReexport + +deriving via (ViaPretty Mixin) instance ToJSON Mixin + +deriving via (ViaPretty PkgconfigDependency) instance ToJSON PkgconfigDependency + +deriving via (ViaPretty ExeDependency) instance ToJSON ExeDependency + +deriving via (ViaPretty LegacyExeDependency) instance ToJSON LegacyExeDependency + +deriving via (ViaPretty LibraryVisibility) instance ToJSON LibraryVisibility diff --git a/app/Foliage/Pages.hs b/app/Foliage/Pages.hs index afd6b39..c0c103f 100644 --- a/app/Foliage/Pages.hs +++ b/app/Foliage/Pages.hs @@ -14,7 +14,6 @@ module Foliage.Pages ) where -import Control.Monad (unless) import Data.Aeson (KeyValue ((.=)), ToJSON, object) import Data.Function (on, (&)) import Data.List (sortOn) @@ -24,7 +23,7 @@ import Data.Ord (Down (Down), comparing) import Data.Text.Lazy.IO.Utf8 qualified as TL import Data.Time (UTCTime) import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds) -import Development.Shake (Action, putWarn, traced) +import Development.Shake (Action, traced) import Distribution.Aeson (jsonGenericPackageDescription) import Distribution.Package (PackageIdentifier (pkgName, pkgVersion)) import Distribution.Pretty (prettyShow) @@ -35,7 +34,7 @@ import Foliage.Utils.Aeson (MyAesonEncoding (..)) import GHC.Generics (Generic) import System.Directory qualified as IO import System.FilePath (()) -import Text.Mustache (Template, displayMustacheWarning, renderMustacheW) +import Text.Mustache (Template) import Text.Mustache.Compile.TH (compileMustacheDir) import Text.Mustache.Render (renderMustache) @@ -144,29 +143,18 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions = & sortOn (Down . allPackageVersionsPageEntryTimestamp) makePackageVersionPage :: FilePath -> PreparedPackageVersion -> Action () -makePackageVersionPage - outputDir - PreparedPackageVersion - { pkgId, - pkgTimestamp, - pkgVersionSource, - pkgDesc, - cabalFileRevisions, - pkgVersionIsDeprecated - } = do - let (warnings, text) = - renderMustacheW packageVersionPageTemplate $ - object - [ "pkgVersionSource" .= pkgVersionSource, - "cabalFileRevisions" .= map fst cabalFileRevisions, - "pkgDesc" .= jsonGenericPackageDescription pkgDesc, - "pkgTimestamp" .= pkgTimestamp, - "pkgVersionDeprecated" .= pkgVersionIsDeprecated - ] - traced ("webpages / package / " ++ prettyShow pkgId) $ do - IO.createDirectoryIfMissing True (outputDir "package" prettyShow pkgId) - TL.writeFile (outputDir "package" prettyShow pkgId "index.html") text - unless (null warnings) $ putWarn $ unlines (map displayMustacheWarning warnings) +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 + ] indexPageTemplate :: Template indexPageTemplate = $(compileMustacheDir "index" "templates") diff --git a/foliage.cabal b/foliage.cabal index 65a4714..b694cd6 100644 --- a/foliage.cabal +++ b/foliage.cabal @@ -65,5 +65,6 @@ executable foliage time >=1.9.3 && <1.13, time-compat >=1.9.6.1 && <1.10, tomland >=1.3.3.1 && <1.4, + vector >=0.13.0.0 && <0.14, with-utf8 >=1.0.2.3 && <1.1, - zlib >=0.6.2.3 && <0.7 + zlib >=0.6.2.3 && <0.7, diff --git a/templates/cond-tree-dependency.mustache b/templates/cond-tree-dependency.mustache deleted file mode 100644 index 553f607..0000000 --- a/templates/cond-tree-dependency.mustache +++ /dev/null @@ -1,9 +0,0 @@ -{{#build-depends}} -
  • {{.}}
    • -{{/build-depends}} -{{#if.then.build-depends}} -
  • {{.}} if {{if.cond}}
    • -{{/if.then.build-depends}} -{{#if.else.build-depends}} -
  • {{.}} unless {{if.cond}}
    • -{{/if.else.build-depends}} diff --git a/templates/dependencies.mustache b/templates/dependencies.mustache new file mode 100644 index 0000000..292c1cf --- /dev/null +++ b/templates/dependencies.mustache @@ -0,0 +1,17 @@ + +{{#build-depends}} +{{#if}} +

    if {{.}}

    + +{{/if}} +{{/build-depends}} diff --git a/templates/packageVersion.mustache b/templates/packageVersion.mustache index 8e45303..9003b06 100644 --- a/templates/packageVersion.mustache +++ b/templates/packageVersion.mustache @@ -13,7 +13,6 @@