mirror of
https://github.com/input-output-hk/foliage.git
synced 2024-09-11 20:27:09 +03:00
Display build dependencies better
This commit is contained in:
parent
1f899fe101
commit
e51484454e
@ -13,11 +13,8 @@ module Distribution.Aeson where
|
|||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.Key qualified as Key
|
import Data.Aeson.Key qualified as Key
|
||||||
import Data.Aeson.KeyMap qualified as KeyMap
|
|
||||||
import Data.Aeson.Types
|
import Data.Aeson.Types
|
||||||
import Data.Bifunctor (second)
|
import Data.List.NonEmpty qualified as NE
|
||||||
import Data.List (foldl1')
|
|
||||||
import Data.String (fromString)
|
|
||||||
import Distribution.CabalSpecVersion
|
import Distribution.CabalSpecVersion
|
||||||
import Distribution.Compat.Lens hiding ((.=))
|
import Distribution.Compat.Lens hiding ((.=))
|
||||||
import Distribution.Compat.Newtype
|
import Distribution.Compat.Newtype
|
||||||
@ -124,7 +121,9 @@ instance ToJSON ConfVar where
|
|||||||
toJSON (OS os) = object ["os" .= os]
|
toJSON (OS os) = object ["os" .= os]
|
||||||
toJSON (Arch arch) = object ["arcg" .= arch]
|
toJSON (Arch arch) = object ["arcg" .= arch]
|
||||||
toJSON (PackageFlag flag) = object ["os" .= flag]
|
toJSON (PackageFlag flag) = object ["os" .= flag]
|
||||||
toJSON (Impl compiler version) = object ["compiler" .= compiler, "version" .= version]
|
toJSON (Impl compiler version)
|
||||||
|
| isAnyVersion version = object ["compiler" .= compiler]
|
||||||
|
| otherwise = object ["compiler" .= compiler, "version" .= version]
|
||||||
|
|
||||||
instance ToJSON c => ToJSON (Condition c) where
|
instance ToJSON c => ToJSON (Condition c) where
|
||||||
toJSON (Var v) = toJSON v
|
toJSON (Var v) = toJSON v
|
||||||
@ -134,66 +133,66 @@ instance ToJSON c => ToJSON (Condition c) where
|
|||||||
toJSON (CAnd l r) = object ["and" .= [l, r]]
|
toJSON (CAnd l r) = object ["and" .= [l, r]]
|
||||||
|
|
||||||
newtype JSONFieldGrammar s a = JsonFG
|
newtype JSONFieldGrammar s a = JsonFG
|
||||||
{ fieldGrammarJSON :: CabalSpecVersion -> [Condition ConfVar] -> s -> [Pair]
|
{ fieldGrammarJSON :: CabalSpecVersion -> s -> [Pair]
|
||||||
}
|
}
|
||||||
deriving (Functor)
|
deriving (Functor)
|
||||||
|
|
||||||
type JSONFieldGrammar' s = JSONFieldGrammar s s
|
type JSONFieldGrammar' s = JSONFieldGrammar s s
|
||||||
|
|
||||||
jsonFieldGrammar :: CabalSpecVersion -> [Condition ConfVar] -> JSONFieldGrammar s a -> s -> [Pair]
|
jsonFieldGrammar :: CabalSpecVersion -> JSONFieldGrammar s a -> s -> [Pair]
|
||||||
jsonFieldGrammar v cs fg = fieldGrammarJSON fg v cs
|
jsonFieldGrammar v fg = fieldGrammarJSON fg v
|
||||||
|
|
||||||
instance Applicative (JSONFieldGrammar s) where
|
instance Applicative (JSONFieldGrammar s) where
|
||||||
pure _ = JsonFG (\_ _ _ -> mempty)
|
pure _ = JsonFG (\_ _ -> mempty)
|
||||||
JsonFG f <*> JsonFG x = JsonFG (\v cs s -> f v cs s <> x v cs s)
|
JsonFG f <*> JsonFG x = JsonFG (\v s -> f v s <> x v s)
|
||||||
|
|
||||||
instance FieldGrammar ToJSON JSONFieldGrammar where
|
instance FieldGrammar ToJSON JSONFieldGrammar where
|
||||||
blurFieldGrammar :: ALens' a b -> JSONFieldGrammar b d -> JSONFieldGrammar a d
|
blurFieldGrammar :: ALens' a b -> JSONFieldGrammar b d -> JSONFieldGrammar a d
|
||||||
blurFieldGrammar f (JsonFG fg) = JsonFG $ \v cs ->
|
blurFieldGrammar f (JsonFG fg) = JsonFG $ \v ->
|
||||||
fg v cs . aview f
|
fg v . aview f
|
||||||
|
|
||||||
uniqueFieldAla :: (ToJSON b, Newtype a b) => FieldName -> (a -> b) -> ALens' s a -> JSONFieldGrammar s a
|
uniqueFieldAla :: (ToJSON b, Newtype a b) => FieldName -> (a -> b) -> ALens' s a -> JSONFieldGrammar s a
|
||||||
uniqueFieldAla fn _pack l = JsonFG $ \_v cs ->
|
uniqueFieldAla fn _pack l = JsonFG $ \_v ->
|
||||||
jsonField cs fn . toJSON . pack' _pack . aview l
|
jsonField fn . toJSON . pack' _pack . aview l
|
||||||
|
|
||||||
booleanFieldDef :: FieldName -> ALens' s Bool -> Bool -> JSONFieldGrammar s Bool
|
booleanFieldDef :: FieldName -> ALens' s Bool -> Bool -> JSONFieldGrammar s Bool
|
||||||
booleanFieldDef fn l def = JsonFG $ \_v cs s ->
|
booleanFieldDef fn l def = JsonFG $ \_v s ->
|
||||||
let b = aview l s
|
let b = aview l s
|
||||||
in if b == def
|
in if b == def
|
||||||
then mempty
|
then mempty
|
||||||
else jsonField cs fn (toJSON b)
|
else jsonField fn (toJSON b)
|
||||||
|
|
||||||
optionalFieldAla :: (ToJSON b, Newtype a b) => FieldName -> (a -> b) -> ALens' s (Maybe a) -> JSONFieldGrammar s (Maybe a)
|
optionalFieldAla :: (ToJSON b, Newtype a b) => FieldName -> (a -> b) -> ALens' s (Maybe a) -> JSONFieldGrammar s (Maybe a)
|
||||||
optionalFieldAla fn _pack l = JsonFG $ \_ cs s ->
|
optionalFieldAla fn _pack l = JsonFG $ \_ s ->
|
||||||
case aview l s of
|
case aview l s of
|
||||||
Nothing -> mempty
|
Nothing -> mempty
|
||||||
Just a -> jsonField cs fn (toJSON (pack' _pack a))
|
Just a -> jsonField fn (toJSON (pack' _pack a))
|
||||||
|
|
||||||
optionalFieldDefAla :: (ToJSON b, Newtype a b, Eq a) => FieldName -> (a -> b) -> ALens' s a -> a -> JSONFieldGrammar s 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 $ \_ cs s ->
|
optionalFieldDefAla fn _pack l def = JsonFG $ \_ s ->
|
||||||
let x = aview l s
|
let x = aview l s
|
||||||
in if x == def
|
in if x == def
|
||||||
then mempty
|
then mempty
|
||||||
else jsonField cs fn (toJSON (pack' _pack x))
|
else jsonField fn (toJSON (pack' _pack x))
|
||||||
|
|
||||||
freeTextField :: FieldName -> ALens' s (Maybe String) -> JSONFieldGrammar s (Maybe String)
|
freeTextField :: FieldName -> ALens' s (Maybe String) -> JSONFieldGrammar s (Maybe String)
|
||||||
freeTextField fn l = JsonFG $ \_v cs s ->
|
freeTextField fn l = JsonFG $ \_v s ->
|
||||||
maybe mempty (jsonField cs fn . toJSON) (aview l s)
|
maybe mempty (jsonField fn . toJSON) (aview l s)
|
||||||
|
|
||||||
freeTextFieldDef :: FieldName -> ALens' s String -> JSONFieldGrammar s String
|
freeTextFieldDef :: FieldName -> ALens' s String -> JSONFieldGrammar s String
|
||||||
freeTextFieldDef fn l = JsonFG $ \_v cs ->
|
freeTextFieldDef fn l = JsonFG $ \_v ->
|
||||||
jsonField cs fn . toJSON . aview l
|
jsonField fn . toJSON . aview l
|
||||||
|
|
||||||
freeTextFieldDefST :: FieldName -> ALens' s ST.ShortText -> JSONFieldGrammar s ST.ShortText
|
freeTextFieldDefST :: FieldName -> ALens' s ST.ShortText -> JSONFieldGrammar s ST.ShortText
|
||||||
freeTextFieldDefST = defaultFreeTextFieldDefST
|
freeTextFieldDefST = defaultFreeTextFieldDefST
|
||||||
|
|
||||||
monoidalFieldAla :: (ToJSON b, Monoid a, Newtype a b) => FieldName -> (a -> b) -> ALens' s a -> JSONFieldGrammar s a
|
monoidalFieldAla :: (ToJSON b, Monoid a, Newtype a b) => FieldName -> (a -> b) -> ALens' s a -> JSONFieldGrammar s a
|
||||||
monoidalFieldAla fn _pack l = JsonFG $ \_v cs ->
|
monoidalFieldAla fn _pack l = JsonFG $ \_v ->
|
||||||
jsonField cs fn . toJSON . pack' _pack . aview l
|
jsonField fn . toJSON . pack' _pack . aview l
|
||||||
|
|
||||||
prefixedFields :: FieldName -> ALens' s [(String, String)] -> JSONFieldGrammar s [(String, String)]
|
prefixedFields :: FieldName -> ALens' s [(String, String)] -> JSONFieldGrammar s [(String, String)]
|
||||||
prefixedFields _fnPfx l = JsonFG $ \_v _cs s ->
|
prefixedFields fnPfx l = JsonFG $ \_v s ->
|
||||||
[Key.fromString n .= v | (n, v) <- aview l s]
|
[Key.fromString (fromUTF8BS fnPfx <> n) .= v | (n, v) <- aview l s]
|
||||||
|
|
||||||
knownField :: FieldName -> JSONFieldGrammar s ()
|
knownField :: FieldName -> JSONFieldGrammar s ()
|
||||||
knownField _ = pure ()
|
knownField _ = pure ()
|
||||||
@ -210,15 +209,12 @@ instance FieldGrammar ToJSON JSONFieldGrammar where
|
|||||||
|
|
||||||
hiddenField _ = JsonFG (const mempty)
|
hiddenField _ = JsonFG (const mempty)
|
||||||
|
|
||||||
jsonField :: [Condition ConfVar] -> FieldName -> Value -> [Pair]
|
jsonField :: FieldName -> Value -> [Pair]
|
||||||
jsonField cs fn v
|
jsonField fn v
|
||||||
| v == emptyArray = mempty
|
| v == emptyArray = mempty
|
||||||
| v == emptyString = mempty
|
| v == emptyString = mempty
|
||||||
| null cs = [Key.fromString (fromUTF8BS fn) .= v]
|
| otherwise = [Key.fromString (fromUTF8BS fn) .= v]
|
||||||
| otherwise = [Key.fromString (fromUTF8BS fn) .= v']
|
|
||||||
where
|
where
|
||||||
v' = object ["if" .= toJSON (foldl1' CAnd cs), "then" .= v]
|
|
||||||
|
|
||||||
-- Should be added to aeson
|
-- Should be added to aeson
|
||||||
emptyString :: Value
|
emptyString :: Value
|
||||||
emptyString = String ""
|
emptyString = String ""
|
||||||
@ -228,7 +224,6 @@ jsonGenericPackageDescription gpd =
|
|||||||
object $
|
object $
|
||||||
concat
|
concat
|
||||||
[ jsonPackageDescription v (packageDescription gpd),
|
[ jsonPackageDescription v (packageDescription gpd),
|
||||||
jsonSetupBInfo v (setupBuildInfo (packageDescription gpd)),
|
|
||||||
jsonGenPackageFlags v (genPackageFlags gpd),
|
jsonGenPackageFlags v (genPackageFlags gpd),
|
||||||
jsonCondLibrary v (condLibrary gpd),
|
jsonCondLibrary v (condLibrary gpd),
|
||||||
jsonCondSubLibraries v (condSubLibraries gpd),
|
jsonCondSubLibraries v (condSubLibraries gpd),
|
||||||
@ -241,110 +236,101 @@ jsonGenericPackageDescription gpd =
|
|||||||
v = specVersion $ packageDescription gpd
|
v = specVersion $ packageDescription gpd
|
||||||
|
|
||||||
jsonPackageDescription :: CabalSpecVersion -> PackageDescription -> [Pair]
|
jsonPackageDescription :: CabalSpecVersion -> PackageDescription -> [Pair]
|
||||||
jsonPackageDescription v pd =
|
jsonPackageDescription v pd@PackageDescription {sourceRepos, setupBuildInfo} =
|
||||||
jsonFieldGrammar v [] packageDescriptionFieldGrammar pd
|
jsonFieldGrammar v packageDescriptionFieldGrammar pd
|
||||||
++ ["source-repos" .= jsonSourceRepos v (sourceRepos pd)]
|
<> jsonSourceRepos v sourceRepos
|
||||||
|
<> jsonSetupBuildInfo v setupBuildInfo
|
||||||
|
|
||||||
jsonSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [Value]
|
jsonSourceRepos :: CabalSpecVersion -> [SourceRepo] -> [Pair]
|
||||||
jsonSourceRepos v = map (jsonSourceRepo v)
|
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 :: CabalSpecVersion -> SourceRepo -> Value
|
||||||
jsonSourceRepo v repo =
|
jsonSourceRepo v repo@SourceRepo {repoKind} =
|
||||||
object (jsonFieldGrammar v [] (sourceRepoFieldGrammar kind) repo)
|
object $ jsonFieldGrammar v (sourceRepoFieldGrammar repoKind) repo
|
||||||
where
|
|
||||||
kind = repoKind repo
|
|
||||||
|
|
||||||
jsonSetupBInfo :: CabalSpecVersion -> Maybe SetupBuildInfo -> [Pair]
|
|
||||||
jsonSetupBInfo _ Nothing = mempty
|
|
||||||
jsonSetupBInfo v (Just sbi)
|
|
||||||
| defaultSetupDepends sbi = mempty
|
|
||||||
| null vs = mempty
|
|
||||||
| otherwise = ["custom-setup" .= object vs]
|
|
||||||
where
|
|
||||||
vs = jsonFieldGrammar v [] (setupBInfoFieldGrammar False) sbi
|
|
||||||
|
|
||||||
jsonGenPackageFlags :: CabalSpecVersion -> [PackageFlag] -> [Pair]
|
jsonGenPackageFlags :: CabalSpecVersion -> [PackageFlag] -> [Pair]
|
||||||
jsonGenPackageFlags v flags
|
jsonGenPackageFlags v =
|
||||||
| null flags = mempty
|
concatMap (\neFlags -> ["flags" .= NE.map (jsonFlag v) neFlags]) . NE.nonEmpty
|
||||||
| otherwise = ["flags" .= flags']
|
|
||||||
where
|
jsonFlag :: CabalSpecVersion -> PackageFlag -> Value
|
||||||
flags' =
|
jsonFlag v flag@(MkPackageFlag name _ _ _) =
|
||||||
object
|
object [Key.fromString (unFlagName name) .= jsonFieldGrammar v (flagFieldGrammar name) flag]
|
||||||
[ Key.fromString (unFlagName name) .= object (jsonFieldGrammar v [] (flagFieldGrammar name) flag)
|
|
||||||
| flag@(MkPackageFlag name _ _ _) <- flags
|
|
||||||
]
|
|
||||||
|
|
||||||
jsonCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [Pair]
|
jsonCondLibrary :: CabalSpecVersion -> Maybe (CondTree ConfVar [Dependency] Library) -> [Pair]
|
||||||
jsonCondLibrary _ Nothing = mempty
|
jsonCondLibrary v =
|
||||||
jsonCondLibrary v (Just condTree) = ["library" .= condTree']
|
concatMap (\condTree -> ["library" .= object (jsonCondTree v (libraryFieldGrammar LMainLibName) condTree)])
|
||||||
where
|
|
||||||
condTree' = jsonCondTree2 v (libraryFieldGrammar LMainLibName) condTree
|
|
||||||
|
|
||||||
jsonCondSubLibraries :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [Pair]
|
jsonCondSubLibraries :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [Pair]
|
||||||
jsonCondSubLibraries v libs
|
jsonCondSubLibraries v =
|
||||||
| null libs = mempty
|
concatMap (\neLibs -> ["sub-libraries" .= NE.map (jsonSubLibrary v) neLibs]) . NE.nonEmpty
|
||||||
| otherwise = ["sub-libraries" .= libs']
|
|
||||||
where
|
jsonSubLibrary :: CabalSpecVersion -> (UnqualComponentName, CondTree ConfVar [Dependency] Library) -> Value
|
||||||
libs' =
|
jsonSubLibrary v (n, condTree) =
|
||||||
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
|
withName (unUnqualComponentName n) $
|
||||||
jsonCondTree2 v (libraryFieldGrammar $ LSubLibName n) condTree
|
jsonCondTree v (libraryFieldGrammar $ LSubLibName n) condTree
|
||||||
| (n, condTree) <- libs
|
|
||||||
]
|
|
||||||
|
|
||||||
jsonCondForeignLibs :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [Pair]
|
jsonCondForeignLibs :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> [Pair]
|
||||||
jsonCondForeignLibs v flibs
|
jsonCondForeignLibs v =
|
||||||
| null flibs = mempty
|
concatMap (\neFLibs -> ["foreign-libraries" .= NE.map (jsonForeignLibrary v) neFLibs]) . NE.nonEmpty
|
||||||
| otherwise = ["foreign-libraries" .= flibs']
|
|
||||||
where
|
jsonForeignLibrary :: CabalSpecVersion -> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib) -> Value
|
||||||
flibs' =
|
jsonForeignLibrary v (n, condTree) =
|
||||||
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
|
withName (unUnqualComponentName n) $
|
||||||
jsonCondTree2 v (foreignLibFieldGrammar n) condTree
|
jsonCondTree v (foreignLibFieldGrammar n) condTree
|
||||||
| (n, condTree) <- flibs
|
|
||||||
]
|
|
||||||
|
|
||||||
jsonCondExecutables :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [Pair]
|
jsonCondExecutables :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [Pair]
|
||||||
jsonCondExecutables v exes
|
jsonCondExecutables v =
|
||||||
| null exes = mempty
|
concatMap (\neExes -> ["executables" .= NE.map (jsonCondExecutable v) neExes]) . NE.nonEmpty
|
||||||
| otherwise = ["executables" .= exes']
|
|
||||||
where
|
jsonCondExecutable :: CabalSpecVersion -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable) -> Value
|
||||||
exes' =
|
jsonCondExecutable v (n, condTree) =
|
||||||
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
|
withName (unUnqualComponentName n) $
|
||||||
jsonCondTree2 v (executableFieldGrammar n) condTree
|
jsonCondTree v (executableFieldGrammar n) condTree
|
||||||
| (n, condTree) <- exes
|
|
||||||
]
|
|
||||||
|
|
||||||
jsonCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [Pair]
|
jsonCondTestSuites :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [Pair]
|
||||||
jsonCondTestSuites v suites
|
jsonCondTestSuites v =
|
||||||
| null suites = mempty
|
concatMap (\neSuites -> ["test-suites" .= NE.map (jsonCondTestSuite v) neSuites]) . NE.nonEmpty
|
||||||
| otherwise = ["test-suites" .= suites']
|
|
||||||
where
|
jsonCondTestSuite :: CabalSpecVersion -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite) -> Value
|
||||||
suites' =
|
jsonCondTestSuite v (n, condTree) =
|
||||||
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
|
withName (unUnqualComponentName n) $
|
||||||
jsonCondTree2 v testSuiteFieldGrammar (fmap unvalidateTestSuite condTree)
|
jsonCondTree v testSuiteFieldGrammar (fmap unvalidateTestSuite condTree)
|
||||||
| (n, condTree) <- suites
|
|
||||||
]
|
|
||||||
|
|
||||||
jsonCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [Pair]
|
jsonCondBenchmarks :: CabalSpecVersion -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [Pair]
|
||||||
jsonCondBenchmarks v suites
|
jsonCondBenchmarks v =
|
||||||
| null suites = mempty
|
concatMap (\neSuites -> ["test-suites" .= NE.map (jsonCondBenchmark v) neSuites]) . NE.nonEmpty
|
||||||
| otherwise = ["benchmarks" .= suites']
|
|
||||||
|
jsonCondBenchmark :: CabalSpecVersion -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark) -> Value
|
||||||
|
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
|
||||||
where
|
where
|
||||||
suites' =
|
goNode (CondNode it _ ifs) =
|
||||||
[ KeyMap.insert "name" (fromString $ unUnqualComponentName n) $
|
jsonFieldGrammar v grammar it ++ concatMap goBranch ifs
|
||||||
jsonCondTree2 v benchmarkFieldGrammar (fmap unvalidateBenchmark condTree)
|
|
||||||
| (n, condTree) <- suites
|
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)
|
||||||
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
jsonCondTree2 :: CabalSpecVersion -> JSONFieldGrammar' s -> CondTree ConfVar [Dependency] s -> KeyMap.KeyMap Value
|
withName :: ToJSON v => v -> [Pair] -> Value
|
||||||
jsonCondTree2 v grammar = merge . go []
|
withName n s = object $ ("name" .= n) : s
|
||||||
where
|
|
||||||
go cs (CondNode it _ ifs) =
|
|
||||||
jsonFieldGrammar v cs grammar it ++ concatMap (jsonIf cs) ifs
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
merge :: [Pair] -> KeyMap.KeyMap Value
|
|
||||||
merge = fmap toJSON . KeyMap.fromListWith (<>) . map (second (: []))
|
|
||||||
|
@ -14,6 +14,7 @@ module Foliage.Pages
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
import Control.Monad (unless)
|
||||||
import Data.Aeson (KeyValue ((.=)), ToJSON, object)
|
import Data.Aeson (KeyValue ((.=)), ToJSON, object)
|
||||||
import Data.Function (on, (&))
|
import Data.Function (on, (&))
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
@ -23,7 +24,7 @@ import Data.Ord (Down (Down), comparing)
|
|||||||
import Data.Text.Lazy.IO.Utf8 qualified as TL
|
import Data.Text.Lazy.IO.Utf8 qualified as TL
|
||||||
import Data.Time (UTCTime)
|
import Data.Time (UTCTime)
|
||||||
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
|
||||||
import Development.Shake (Action, traced)
|
import Development.Shake (Action, putWarn, traced)
|
||||||
import Distribution.Aeson (jsonGenericPackageDescription)
|
import Distribution.Aeson (jsonGenericPackageDescription)
|
||||||
import Distribution.Package (PackageIdentifier (pkgName, pkgVersion))
|
import Distribution.Package (PackageIdentifier (pkgName, pkgVersion))
|
||||||
import Distribution.Pretty (prettyShow)
|
import Distribution.Pretty (prettyShow)
|
||||||
@ -34,7 +35,7 @@ import Foliage.Utils.Aeson (MyAesonEncoding (..))
|
|||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import System.Directory qualified as IO
|
import System.Directory qualified as IO
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import Text.Mustache (Template)
|
import Text.Mustache (Template, displayMustacheWarning, renderMustacheW)
|
||||||
import Text.Mustache.Compile.TH (compileMustacheDir)
|
import Text.Mustache.Compile.TH (compileMustacheDir)
|
||||||
import Text.Mustache.Render (renderMustache)
|
import Text.Mustache.Render (renderMustache)
|
||||||
|
|
||||||
@ -145,18 +146,27 @@ makeAllPackageVersionsPage currentTime outputDir packageVersions =
|
|||||||
makePackageVersionPage :: FilePath -> PreparedPackageVersion -> Action ()
|
makePackageVersionPage :: FilePath -> PreparedPackageVersion -> Action ()
|
||||||
makePackageVersionPage
|
makePackageVersionPage
|
||||||
outputDir
|
outputDir
|
||||||
PreparedPackageVersion {pkgId, pkgTimestamp, pkgVersionSource, pkgDesc, cabalFileRevisions, pkgVersionIsDeprecated} =
|
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
|
traced ("webpages / package / " ++ prettyShow pkgId) $ do
|
||||||
IO.createDirectoryIfMissing True (outputDir </> "package" </> prettyShow pkgId)
|
IO.createDirectoryIfMissing True (outputDir </> "package" </> prettyShow pkgId)
|
||||||
TL.writeFile (outputDir </> "package" </> prettyShow pkgId </> "index.html") $
|
TL.writeFile (outputDir </> "package" </> prettyShow pkgId </> "index.html") text
|
||||||
renderMustache packageVersionPageTemplate $
|
unless (null warnings) $ putWarn $ unlines (map displayMustacheWarning warnings)
|
||||||
object
|
|
||||||
[ "pkgVersionSource" .= pkgVersionSource,
|
|
||||||
"cabalFileRevisions" .= map fst cabalFileRevisions,
|
|
||||||
"pkgDesc" .= jsonGenericPackageDescription pkgDesc,
|
|
||||||
"pkgTimestamp" .= pkgTimestamp,
|
|
||||||
"pkgVersionDeprecated" .= pkgVersionIsDeprecated
|
|
||||||
]
|
|
||||||
|
|
||||||
indexPageTemplate :: Template
|
indexPageTemplate :: Template
|
||||||
indexPageTemplate = $(compileMustacheDir "index" "templates")
|
indexPageTemplate = $(compileMustacheDir "index" "templates")
|
||||||
|
9
templates/cond-tree-dependency.mustache
Normal file
9
templates/cond-tree-dependency.mustache
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
{{#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}}
|
@ -1,91 +1,149 @@
|
|||||||
<!doctype html>
|
<!doctype html>
|
||||||
<html lang="en">
|
<html lang="en">
|
||||||
<head>
|
|
||||||
<!-- Required meta tags -->
|
<head>
|
||||||
<meta charset="utf-8">
|
<!-- Required meta tags -->
|
||||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
<meta charset="utf-8">
|
||||||
<!-- Bootstrap CSS -->
|
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||||
<link href="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" rel="stylesheet" integrity="sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" crossorigin="anonymous">
|
<!-- Bootstrap CSS -->
|
||||||
<title>
|
<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}}-{{pkgDesc.version}}
|
||||||
|
</title>
|
||||||
|
<style>
|
||||||
|
ul.build-depends {
|
||||||
|
display: inline;
|
||||||
|
list-style: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
ul.build-depends li {
|
||||||
|
display: inline;
|
||||||
|
}
|
||||||
|
|
||||||
|
ul.build-depends li:not(:last-child):after {
|
||||||
|
content: ",";
|
||||||
|
}
|
||||||
|
</style>
|
||||||
|
</head>
|
||||||
|
|
||||||
|
<body>
|
||||||
|
<div class="container px-4 py-5">
|
||||||
|
<ul class="nav">
|
||||||
|
<li class="nav-item">
|
||||||
|
<a class="nav-link" href="../../index.html">Home</a>
|
||||||
|
</li>
|
||||||
|
<li class="nav-item">
|
||||||
|
<a class="nav-link" href="../../all-packages/index.html">All packages</a>
|
||||||
|
</li>
|
||||||
|
<li class="nav-item">
|
||||||
|
<a class="nav-link" href="../../all-package-versions/index.html">All package versions</a>
|
||||||
|
</li>
|
||||||
|
</ul>
|
||||||
|
<h1 class="py-5">
|
||||||
{{pkgDesc.name}}-{{pkgDesc.version}}
|
{{pkgDesc.name}}-{{pkgDesc.version}}
|
||||||
</title>
|
</h1>
|
||||||
</head>
|
<dl class="row class=" px-4 py-5">
|
||||||
<body>
|
{{#pkgVersionDeprecated}}
|
||||||
<div class="container px-4 py-5">
|
<dt class="col-sm-3"><span class="badge bg-danger" style="font-size: 1em">Deprecated</span></dt>
|
||||||
<ul class="nav">
|
<dd></dd>
|
||||||
<li class="nav-item">
|
{{/pkgVersionDeprecated}}
|
||||||
<a class="nav-link" href="../../index.html">Home</a>
|
<dt class="col-sm-3">Synopsis</dt>
|
||||||
</li>
|
<dd class="col-sm-9">
|
||||||
<li class="nav-item">
|
<p>{{pkgDesc.synopsis}}</p>
|
||||||
<a class="nav-link" href="../../all-packages/index.html">All packages</a>
|
</dd>
|
||||||
</li>
|
<dt class="col-sm-3">Description</dt>
|
||||||
<li class="nav-item">
|
<dd class="col-sm-9">
|
||||||
<a class="nav-link" href="../../all-package-versions/index.html">All package versions</a>
|
<p>{{pkgDesc.description}}</p>
|
||||||
</li>
|
</dd>
|
||||||
</ul>
|
<dt class="col-sm-3">Author</dt>
|
||||||
<h1 class="py-5">
|
<dd class="col-sm-9">
|
||||||
{{pkgDesc.name}}-{{pkgDesc.version}}
|
<p>{{pkgDesc.author}}</p>
|
||||||
</h1>
|
</dd>
|
||||||
<dl class="row class="px-4 py-5">
|
<dt class="col-sm-3">Maintainer</dt>
|
||||||
{{#pkgVersionDeprecated}}
|
<dd class="col-sm-9">
|
||||||
<dt class="col-sm-3"><span class="badge bg-danger" style="font-size: 1em">Deprecated</span></dt>
|
<p>{{pkgDesc.maintainer}}</p>
|
||||||
<dd></dd>
|
</dd>
|
||||||
{{/pkgVersionDeprecated}}
|
<dt class="col-sm-3">License</dt>
|
||||||
<dt class="col-sm-3">Synopsis</dt>
|
<dd class="col-sm-9">
|
||||||
<dd class="col-sm-9"><p>{{pkgDesc.synopsis}}</p></dd>
|
<p>{{pkgDesc.license}}</p>
|
||||||
<dt class="col-sm-3">Description</dt>
|
</dd>
|
||||||
<dd class="col-sm-9"><p>{{pkgDesc.description}}</p></dd>
|
{{#pkgVersionSource}}
|
||||||
<dt class="col-sm-3">Author</dt>
|
<dt class="col-sm-3">Source</dt>
|
||||||
<dd class="col-sm-9"><p>{{pkgDesc.author}}</p></dd>
|
<dd class="col-sm-9">
|
||||||
<dt class="col-sm-3">Maintainer</dt>
|
<dl class="row">
|
||||||
<dd class="col-sm-9"><p>{{pkgDesc.maintainer}}</p></dd>
|
{{> packageVersionSource}}
|
||||||
<dt class="col-sm-3">License</dt>
|
</dl>
|
||||||
<dd class="col-sm-9"><p>{{pkgDesc.license}}</p></dd>
|
</dd>
|
||||||
{{#pkgVersionSource}}
|
{{/pkgVersionSource}}
|
||||||
<dt class="col-sm-3">Source</dt>
|
<dt class="col-sm-3">Timestamp</dt>
|
||||||
<dd class="col-sm-9">
|
<dd class="col-sm-9">
|
||||||
<dl class="row">
|
<p>{{pkgTimestamp}}</p>
|
||||||
{{> packageVersionSource}}
|
</dd>
|
||||||
</dl>
|
<dt class="col-sm-3">Revisions</dt>
|
||||||
</dd>
|
<dd class="col-sm-9">
|
||||||
{{/pkgVersionSource}}
|
{{#cabalFileRevisions}}
|
||||||
<dt class="col-sm-3">Timestamp</dt>
|
<p>{{.}}</p>
|
||||||
<dd class="col-sm-9"><p>{{pkgTimestamp}}</p></dd>
|
{{/cabalFileRevisions}}
|
||||||
<dt class="col-sm-3">Revisions</dt>
|
{{^cabalFileRevisions}}
|
||||||
<dd class="col-sm-9">
|
<p>None</p>
|
||||||
{{#cabalFileRevisions}}
|
{{/cabalFileRevisions}}
|
||||||
<p>{{.}}</p>
|
</dd>
|
||||||
{{/cabalFileRevisions}}
|
<dt class="col-sm-3">Dependencies</dt>
|
||||||
{{^cabalFileRevisions}}
|
<dd class="col-sm-9">
|
||||||
<p>None</p>
|
<dl>
|
||||||
{{/cabalFileRevisions}}
|
{{#pkgDesc.library}}
|
||||||
</dd>
|
<dt>library:</dt>
|
||||||
{{#pkgDesc.library}}
|
<dd>
|
||||||
<dt class="col-sm-3">Dependencies</dt>
|
<ul class="build-depends">
|
||||||
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
|
{{> cond-tree-dependency}}
|
||||||
{{/pkgDesc.library}}
|
</ul>
|
||||||
</dd>
|
</dd>
|
||||||
{{#pkgDesc.sub-libraries}}
|
{{/pkgDesc.library}}
|
||||||
<dt class="col-sm-3">sub-library {{name}}</dt>
|
{{#pkgDesc.sub-libraries}}
|
||||||
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
|
<dt>library {{name}}:</dt>
|
||||||
{{/pkgDesc.sub-libraries}}
|
<dd>
|
||||||
{{#pkgDesc.foreign-libraries}}
|
<ul class="build-depends">
|
||||||
<dt class="col-sm-3">foreign-library {{name}}</dt>
|
{{> cond-tree-dependency}}
|
||||||
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
|
</ul>
|
||||||
{{/pkgDesc.foreign-libraries}}
|
</dd>
|
||||||
{{#pkgDesc.executables}}
|
{{/pkgDesc.sub-libraries}}
|
||||||
<dt class="col-sm-3">executable {{name}}</dt>
|
{{#pkgDesc.foreign-libraries}}
|
||||||
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
|
<dt>foreign library {{name}}:</dt>
|
||||||
{{/pkgDesc.executables}}
|
<dd>
|
||||||
{{#pkgDesc.test-suites}}
|
<ul class="build-depends">
|
||||||
<dt class="col-sm-3">test-suite {{name}}</dt>
|
{{> cond-tree-dependency}}
|
||||||
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
|
</ul>
|
||||||
{{/pkgDesc.test-suites}}
|
</dd>
|
||||||
{{#pkgDesc.benchmarks}}
|
{{/pkgDesc.foreign-libraries}}
|
||||||
<dt class="col-sm-3">benchmark {{name}}</dt>
|
{{#pkgDesc.executables}}
|
||||||
<dd class="col-sm-9">{{#build-depends}}{{#.}}{{.}}<br>{{/.}}{{/build-depends}}</dd>
|
<dt>executable {{name}}:</dt>
|
||||||
{{/pkgDesc.benchmarks}}
|
<dd>
|
||||||
</dl>
|
<ul class="build-depends">
|
||||||
</div>
|
{{> cond-tree-dependency}}
|
||||||
</body>
|
</ul>
|
||||||
|
</dd>
|
||||||
|
{{/pkgDesc.executables}}
|
||||||
|
{{#pkgDesc.test-suites}}
|
||||||
|
<dt>test-suite {{name}}:</dt>
|
||||||
|
<dd>
|
||||||
|
<ul class="build-depends">
|
||||||
|
{{> cond-tree-dependency}}
|
||||||
|
</ul>
|
||||||
|
</dd>
|
||||||
|
{{/pkgDesc.test-suites}}
|
||||||
|
{{#pkgDesc.benchmarks}}
|
||||||
|
<dt>benchmark {{name}}:</dt>
|
||||||
|
<dd>
|
||||||
|
<ul class="build-depends">
|
||||||
|
{{> cond-tree-dependency}}
|
||||||
|
</ul>
|
||||||
|
</dd>
|
||||||
|
{{/pkgDesc.benchmarks}}
|
||||||
|
</dl>
|
||||||
|
</dd>
|
||||||
|
</dl>
|
||||||
|
</div>
|
||||||
|
</body>
|
||||||
|
|
||||||
</html>
|
</html>
|
||||||
|
Loading…
Reference in New Issue
Block a user