website: directory page (#6283)

* website: directory page

* core: use markdown in directory entries

* render markdown on directory page

* update markdown

* toggle secrets on click

* update listings asynchronously

* add group links to the listing

* cleanup

* better directory layout with pagination

* script to run website

* update page navigation

* search

* readable markdown colors, better "read less"

* core: atomic update of directory listings, to avoid files unavailable

* fix symlink, sort entries on page with new first

* update listings every 15 min, add activeAt time

* fix sorting in the page and listing url

* replace simplex:/ links on desktop
This commit is contained in:
Evgeny
2025-09-20 19:47:50 +01:00
committed by GitHub
parent 429ec9d21a
commit a190d4ea9b
22 changed files with 994 additions and 191 deletions

View File

@@ -29,7 +29,6 @@ import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.Protocol
import Simplex.Chat.Store.Groups
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
@@ -69,7 +68,7 @@ chatTypesDocs = sortOn docTypeName $! snd $! mapAccumL toCTDoc (S.empty, M.empty
let (tds', td_) = toTypeDef tds sumTypeInfo
in case td_ of
Just typeDef -> (tds', CTDoc {typeDef, typeSyntax, typeDescr})
Nothing -> error $ "Recursive type: " <> typeName
Nothing -> error $ "Recursive type: " <> typeName
toTypeDef :: (S.Set String, M.Map String APITypeDef) -> (SumTypeInfo, SumTypeJsonEncoding, String, [ConsName], Expr, Text) -> ((S.Set String, M.Map String APITypeDef), Maybe APITypeDef)
toTypeDef acc@(!visited, !typeDefs) (STI typeName allConstrs, jsonEncoding, consPrefix, hideConstrs, _, _) =
@@ -84,7 +83,7 @@ toTypeDef acc@(!visited, !typeDefs) (STI typeName allConstrs, jsonEncoding, cons
let fields = fromMaybe (error $ "Record type without fields: " <> typeName) $ L.nonEmpty fieldInfos
((visited', typeDefs'), fields') = mapAccumL (toAPIField_ typeName) (S.insert typeName visited, typeDefs) fields
td = APITypeDef typeName $ ATDRecord $ L.toList fields'
in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td)
in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td)
_ -> error $ "Record type with " <> show (length constrs) <> " constructors: " <> typeName
STUnion -> if length constrs > 1 then toUnionType constrs else unionError constrs
STUnion1 -> if length constrs == 1 then toUnionType constrs else unionError constrs
@@ -98,16 +97,16 @@ toTypeDef acc@(!visited, !typeDefs) (STI typeName allConstrs, jsonEncoding, cons
toUnionType constrs =
let ((visited', typeDefs'), members) = mapAccumL toUnionMember (S.insert typeName visited, typeDefs) $ fromMaybe (unionError constrs) $ L.nonEmpty constrs
td = APITypeDef typeName $ ATDUnion members
in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td)
in ((S.insert typeName visited', M.insert typeName td typeDefs'), Just td)
toUnionMember tds RecordTypeInfo {consName, fieldInfos} =
let memberTag = normalizeConsName consPrefix consName
in second (ATUnionMember memberTag) $ mapAccumL (toAPIField_ typeName) tds fieldInfos
in second (ATUnionMember memberTag) $ mapAccumL (toAPIField_ typeName) tds fieldInfos
unionError constrs = error $ "Union type with " <> show (length constrs) <> " constructor(s): " <> typeName
toEnumType = toEnumType_ $ normalizeConsName consPrefix
toEnumType_ f constrs =
let members = L.map toEnumMember $ fromMaybe (enumError constrs) $ L.nonEmpty constrs
td = APITypeDef typeName $ ATDEnum members
in ((S.insert typeName visited, M.insert typeName td typeDefs), Just td)
in ((S.insert typeName visited, M.insert typeName td typeDefs), Just td)
where
toEnumMember RecordTypeInfo {consName, fieldInfos} = case fieldInfos of
[] -> f consName
@@ -121,7 +120,7 @@ toAPIField_ typeName tds (FieldInfo fieldName typeInfo) = second (APIRecordField
toAPIType = \case
TIType (ST name _) -> apiTypeForName name
TIOptional tInfo -> second ATOptional $ toAPIType tInfo
TIArray {elemType, nonEmpty} -> second (`ATArray`nonEmpty) $ toAPIType elemType
TIArray {elemType, nonEmpty} -> second (`ATArray` nonEmpty) $ toAPIType elemType
TIMap {keyType = ST name _, valueType}
| name `elem` primitiveTypes -> second (ATMap (PT name)) $ toAPIType valueType
| otherwise -> error $ "Non-primitive key type in " <> typeName <> ", " <> fieldName
@@ -133,7 +132,7 @@ toAPIField_ typeName tds (FieldInfo fieldName typeInfo) = second (APIRecordField
Nothing -> case find (\(STI name' _, _, _, _, _, _) -> name == name') chatTypesDocsData of
Just sumTypeInfo ->
let (tds', td_) = toTypeDef tds sumTypeInfo -- recursion to outer function, loops are resolved via type defs map lookup
in case td_ of
in case td_ of
Just td -> (tds', ATDef td)
Nothing -> (tds', ATRef name)
Nothing -> error $ "Undefined type: " <> name
@@ -352,7 +351,6 @@ chatTypesDocsData =
(sti @XFTPErrorType, STUnion, "", [], "", ""),
(sti @XFTPRcvFile, STRecord, "", [], "", ""),
(sti @XFTPSndFile, STRecord, "", [], "", "")
-- (sti @DatabaseError, STUnion, "DB", [], "", ""),
-- (sti @ChatItemInfo, STRecord, "", [], "", ""),
-- (sti @ChatItemVersion, STRecord, "", [], "", ""),
@@ -371,7 +369,7 @@ chatTypesDocsData =
-- (sti @SendRef, STRecord, "", [], "", ""),
-- (sti @SndQueueInfo, STRecord, "", [], "", ""),
-- (sti @SndSwitchStatus, STEnum, "", [], "", ""), -- incorrect
]
]
data SimplePreference = SimplePreference {allow :: FeatureAllowed} deriving (Generic)