diff options
Diffstat (limited to 'src/FSD/Wiki.hs')
-rw-r--r-- | src/FSD/Wiki.hs | 156 |
1 files changed, 156 insertions, 0 deletions
diff --git a/src/FSD/Wiki.hs b/src/FSD/Wiki.hs new file mode 100644 index 0000000..78e43f0 --- /dev/null +++ b/src/FSD/Wiki.hs @@ -0,0 +1,156 @@ +{- +Copyright (C) 2022 Yuchen Pei. + +This file is part of fsd. + +fsd is free software: you can redistribute it and/or modify it under +the terms of the GNU Affero General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +fsd is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General +Public License for more details. + +You should have received a copy of the GNU Affero General Public +License along with fsd. If not, see <https://www.gnu.org/licenses/>. + +-} + +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE OverloadedStrings #-} + +module FSD.Wiki (formatWikiEntry) where + +import Data.Maybe +import Data.List.Extra +import Data.Text (Text) +import Data.Text qualified as T +import Data.Time +import FSD.Types + +data WikiTemplate = WikiTemplate + { templateName :: Text, + templateParams :: [(Text, Text)] + } + +formatTemplate :: WikiTemplate -> Text +formatTemplate (WikiTemplate name params) = + T.unlines $ + (T.concat ["{{", name]) : + ( fmap + (\(key, val) -> T.concat ["|", key, "=", val]) + params + ) + ++ ["}}"] +-- The main function that formats a PackageInfo to a wiki entry +formatWikiEntry :: PackageInfo -> Text +formatWikiEntry package = + formatWikiEntry' $ + (wtEntry package) : (wtImport package) : wtLicenses package + ++ wtPersons package ++ wtResources package + +type WikiEntry = [WikiTemplate] + +formatWikiEntry' :: WikiEntry -> Text +formatWikiEntry' = T.concat . fmap formatTemplate + +-- https://directory.fsf.org/wiki/Template:Entry +wtEntry :: PackageInfo -> WikiTemplate +wtEntry package = + WikiTemplate "Entry" + -- this may cause problems some times, like 0ad-data which is a + -- separate package from 0ad, but with the same upstream name (0ad), + -- and can cause overwrite of 0ad info + [ ("Name", fromMaybe (piPackage package) (piUpstreamName package)), + ("Short description", piShortDesc package), + ("Full description", piFullDesc package), + ("Homepage", fromMaybe "" $ piHomepage package), + ("Computer languages", formatImplLangs package), + ("Version identifier", piVersion package), + ("Version download", getDlUrl package), + ("Submitted by", "Debian import"), + ("Submitted date", T.pack $ show $ utctDay $ piTimestamp package) + ] + +formatImplLangs :: PackageInfo -> Text +formatImplLangs package = + T.intercalate "," $ catMaybes $ getLang <$> tagList + where tags = piTags package + tagList = filter (\tag -> head tag == "implemented-in") (T.splitOn "::" <$> tags) + getLang xs = xs !? 1 + +getDlUrl :: PackageInfo -> Text +getDlUrl package = + T.concat + ["http://ftp.debian.org/debian/pool/main/" + , if T.isPrefixOf "lib" name then T.take 4 name else T.take 1 name + , "/", name, "/", file] + where + name = piPackage package + file = piFile package + +-- TODO +-- https://directory.fsf.org/wiki/Template:Software_category +{- +{{Software category +|Game=game:: +|Interface=interface:: +|Protocol=protocol:: +|Use=use:: +... +}} +-} + +-- https://directory.fsf.org/wiki/Template:Import +makeLink :: Text -> Text +makeLink name = T.concat ["http://packages.debian.org/stable/", name] + +wtImport :: PackageInfo -> WikiTemplate +wtImport package = + WikiTemplate + "Import" + [("Source", "Debian"), ("Source link", makeLink $ piPackage package), + ("Date", T.pack $ show $ utctDay $ piTimestamp package)] + +-- https://directory.fsf.org/wiki/Template:Project_license +wtLicenses :: PackageInfo -> [WikiTemplate] +wtLicenses package = + wtLicense (piCLAuthor package) + (T.pack $ show $ utctDay $ piCLTimestamp package) <$> + (piLicenses package) + +wtLicense :: Text -> Text -> LicenseInfo -> WikiTemplate +wtLicense author time info = + WikiTemplate + "Project license" + [ ("License", lLicense info), + ("License copyright", fromMaybe "" $ lCopyright info), + ("License verified by", author), + ("License verified date", time), + ("License note", fromMaybe "" $ lNote info) + ] + +-- https://directory.fsf.org/wiki/Template:Person +data WTPerson = WTPerson + { wpName :: Text, + wpRole :: Text, + wpEmail :: Text + } + +wtPerson :: Contact -> WikiTemplate +wtPerson (Contact name email) = + WikiTemplate + "Person" + [("Real name", fromMaybe "" name), ("Role", "contact"), ("Email", email)] + +wtPersons :: PackageInfo -> [WikiTemplate] +wtPersons info = wtPerson <$> piContacts info + +-- https://directory.fsf.org/wiki/Template:Resource +wtResources :: PackageInfo -> [WikiTemplate] +wtResources package = + (\url -> WikiTemplate "Resource" + [("Resource kind", "Download"), ("Resource URL", url)]) <$> + piSources package |