mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-03-31 03:16:05 +00:00
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:
@@ -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)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user