mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-07-14 23:30:24 +03:00
Display conditionals correctly
This commit is contained in:
Andrea Bedini
parent
e51484454e
commit
56f8b81838
@ -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
|
||||
|
||||
@ -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")
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -1,9 +0,0 @@
|
||||
{{#build-depends}}
|
||||
<li>{{.}}</li>
|
||||
{{/build-depends}}
|
||||
{{#if.then.build-depends}}
|
||||
<li>{{.}} if {{if.cond}}</li>
|
||||
{{/if.then.build-depends}}
|
||||
{{#if.else.build-depends}}
|
||||
<li>{{.}} unless {{if.cond}}</li>
|
||||
{{/if.else.build-depends}}
|
||||
17
templates/dependencies.mustache
Normal file
17
templates/dependencies.mustache
Normal file
@ -0,0 +1,17 @@
|
||||
<ul class="build-depends">
|
||||
{{#build-depends}}
|
||||
{{^if}}
|
||||
<li>{{.}}</li>
|
||||
{{/if}}
|
||||
{{/build-depends}}
|
||||
</ul>
|
||||
{{#build-depends}}
|
||||
{{#if}}
|
||||
<p>if {{.}}</p>
|
||||
<ul class="build-depends">
|
||||
{{#then}}
|
||||
<li>{{.}}</li>
|
||||
{{/then}}
|
||||
</ul>
|
||||
{{/if}}
|
||||
{{/build-depends}}
|
||||
@ -13,7 +13,6 @@
|
||||
</title>
|
||||
<style>
|
||||
ul.build-depends {
|
||||
display: inline;
|
||||
list-style: none;
|
||||
}
|
||||
|
||||
@ -93,51 +92,39 @@
|
||||
<dd class="col-sm-9">
|
||||
<dl>
|
||||
{{#pkgDesc.library}}
|
||||
<dt>library:</dt>
|
||||
<dt>library {{pkgDesc.name}}:</dt>
|
||||
<dd>
|
||||
<ul class="build-depends">
|
||||
{{> cond-tree-dependency}}
|
||||
</ul>
|
||||
{{> dependencies}}
|
||||
</dd>
|
||||
{{/pkgDesc.library}}
|
||||
{{#pkgDesc.sub-libraries}}
|
||||
<dt>library {{name}}:</dt>
|
||||
<dd>
|
||||
<ul class="build-depends">
|
||||
{{> cond-tree-dependency}}
|
||||
</ul>
|
||||
{{> dependencies}}
|
||||
</dd>
|
||||
{{/pkgDesc.sub-libraries}}
|
||||
{{#pkgDesc.foreign-libraries}}
|
||||
<dt>foreign library {{name}}:</dt>
|
||||
<dd>
|
||||
<ul class="build-depends">
|
||||
{{> cond-tree-dependency}}
|
||||
</ul>
|
||||
{{> dependencies}}
|
||||
</dd>
|
||||
{{/pkgDesc.foreign-libraries}}
|
||||
{{#pkgDesc.executables}}
|
||||
<dt>executable {{name}}:</dt>
|
||||
<dd>
|
||||
<ul class="build-depends">
|
||||
{{> cond-tree-dependency}}
|
||||
</ul>
|
||||
{{> dependencies}}
|
||||
</dd>
|
||||
{{/pkgDesc.executables}}
|
||||
{{#pkgDesc.test-suites}}
|
||||
<dt>test-suite {{name}}:</dt>
|
||||
<dd>
|
||||
<ul class="build-depends">
|
||||
{{> cond-tree-dependency}}
|
||||
</ul>
|
||||
{{> dependencies}}
|
||||
</dd>
|
||||
{{/pkgDesc.test-suites}}
|
||||
{{#pkgDesc.benchmarks}}
|
||||
<dt>benchmark {{name}}:</dt>
|
||||
<dd>
|
||||
<ul class="build-depends">
|
||||
{{> cond-tree-dependency}}
|
||||
</ul>
|
||||
{{> dependencies}}
|
||||
</dd>
|
||||
{{/pkgDesc.benchmarks}}
|
||||
</dl>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user