{-
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 #-}
{-# LANGUAGE FlexibleInstances #-}
module FSD.Types where
import Data.Maybe
import Data.Time
import Data.Text (Text)
import Data.Text qualified as T
import Database.SQLite.Simple
import Database.SQLite.Simple.FromField
{- Source
- obtained from dist/Sources.gz
- sPackage, sVersion: key, package and version, also used for {{Entry|Version identifier, Version download and {{Import|Source link and Source packages
- there's also Uploaders field in Source, but it is not as good as the changelog which is more precise on the version
-}
data Source = Source
{sPackage :: Text, sVersion :: Text, sFile :: Text, sHomepage :: Maybe Text}
deriving (Show)
instance ToRow Source where
toRow (Source a b c d) = toRow (a, b, c, d)
instance FromRow Source where
fromRow = Source <$> field <*> field <*> field <*> field
{- Package
- obtained from dist/Packages.gz
- pPackage, pVersion: key, package and version
- comes from Package and Version
- homepage: used for {{Entry|Homepage URL
- comes from Homepage
- also available in Sources.gz
- tags: used for {{Entry|Computer languages (implementing lang)
- can also be used for use, works-with etc.
-}
data Package = Package
{ pPackage :: Text,
pVersion :: Text,
pHomepage :: Maybe Text,
pTags :: Tags
}
deriving (Show)
newtype Tags = Tags {unTags :: [Text]} deriving (Show, Eq)
instance ToRow Package where
toRow (Package a b c d) = toRow (a, b, c, T.intercalate "," $ unTags d)
instance FromRow Package where
fromRow = Package <$> field <*> field <*> field <*> field
instance FromField Tags where
fromField f = Tags <$> T.splitOn "," <$> fromField f
{- Translation
- obtained from dist
- tPackage: key, package name
- comes from Package
- (shortDesc, fullDesc) are for {{Entry|Short description and {{Entry|Full description
- comes from Description-en.syn and .full (formatted text with syn)
-}
data Translation = Translation
{ tPackage :: Text,
tShortDesc :: Text,
tFullDesc :: Text
}
deriving (Show)
instance ToRow Translation where
toRow (Translation a b c) = toRow (a, b, c)
instance FromRow Translation where
fromRow = Translation <$> field <*> field <*> field
{- ChangeLog
- obtained from metaftp
- the latest changelog entry
- clPacakge and clVersion are keys, ignores on mismatch
- author is used for {{Project license|License verified by
- timeStamp for {{Project license|License verified date
-}
data FSDChangeLogEntry = FSDChangeLogEntry
{ clPackage :: Text,
clVersion :: Text,
clAuthor :: Text,
clTimestamp :: UTCTime
}
deriving (Show)
instance ToRow FSDChangeLogEntry where
toRow (FSDChangeLogEntry a b c d) = toRow (a, b, c, d)
instance FromRow FSDChangeLogEntry where
fromRow = FSDChangeLogEntry <$> field <*> field <*> field <*> field
-- copyright types
{-
- upstreamName is used for {{Entry|Name
- stores upstream package name (canonical name);
- comes from Upstream-Name; defined to be name used by upstream;
- some copyright files use Upstream-Name for contacts (but not often), which is rather hard to detect ("Foo Library" and "John Doe" are of the same format"), so we take it at face value
- contacts is used for {{Person|Real name and {{Person|Email with Role=contact
- stores contact name and email address;
- comes from Upstream-Contact (line-based list)
- may contain urls which are ignored
- sources is used for {{Resource|Resource URL with {{Resource|Resource kind=Download
- stores resource urls with download kind;
- comes from Source (formatted text with no synopsis), in practice all in url form
- so we parse it as whitespace separated list of urls
-}
data Contact = Contact
{ coName :: Maybe Text,
coEmail :: Text
}
deriving (Show)
serializeContacts :: [Contact] -> Text
serializeContacts = T.intercalate ";" . fmap serializeContact
serializeContact :: Contact -> Text
serializeContact (Contact name email) =
T.concat [(fromMaybe "" name), ",", email]
deserializeContacts :: Text -> [Contact]
deserializeContacts contacts =
if T.null contacts
then []
else catMaybes $ deserializeContact <$> T.splitOn ";" contacts
deserializeContact :: Text -> Maybe Contact
deserializeContact raw =
case T.splitOn "," raw of
[_, ""] -> Nothing
[name, email] ->
Just $ Contact (if T.null name then Nothing else Just name) email
otherwise -> Nothing
data Upstream = Upstream
{ uPackage :: Text,
uName :: Maybe Text,
uContacts :: [Contact],
uSources :: SourceUrls
}
deriving (Show)
newtype SourceUrls = SourceUrls {unSources :: [Text]} deriving (Eq, Show)
instance ToRow Upstream where
toRow (Upstream a b contacts sources) =
toRow
( a,
b,
serializeContacts contacts,
T.intercalate "\n" $ unSources sources
)
instance FromRow Upstream where
fromRow = Upstream <$> field <*> field <*> field <*> field
instance FromField SourceUrls where
fromField f = SourceUrls <$> T.splitOn "\n" <$> fromField f
instance FromField [Contact] where
fromField f = deserializeContacts <$> fromField f
{- License Information
- we need to filter out debian/* Files
- copyright is used for {{Project license|License copyright
- comes from Files.Copyright and Header.Copyright (formatted text no syn)
- license is used for {{Project license|License
- comes from Files.License.syn and Header.License.syn (formatted text with syn)
- we treat multi-licensing license as one (e.g. "GPL-2+ or MPL" is a valid license field)
- note is used for {{Project license|License note
- comes from Files.License.full and Header.License.full (formatted text with syn), or in case of missing fulls, License.full (formatted text with syn) for matching syn
-}
data LicenseInfo = LicenseInfo
{ lCopyright :: Maybe Text,
lLicense :: Text,
lNote :: Maybe Text
}
deriving (Show)
instance FromRow LicenseInfo where
fromRow = LicenseInfo <$> field <*> field <*> field
{- Obtained from copyright files
- formatted as https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/
- nonformatted files are ignored
-}
data Copyright = Copyright
{ crPackage :: Text,
crLicenses :: [LicenseInfo]
}
deriving (Show)
data PackageInfo = PackageInfo
{ piPackage :: Text,
piVersion :: Text,
piTimestamp :: UTCTime, -- time the PackageInfo is created
piFile :: Text,
piHomepage :: Maybe Text,
piTags :: [Text],
piShortDesc :: Text,
piFullDesc :: Text,
piUpstreamName :: Maybe Text,
piContacts :: [Contact],
piSources :: [Text],
piLicenses :: [LicenseInfo],
piCLAuthor :: Text,
piCLTimestamp :: UTCTime
}
deriving (Show)
{- TODO
- [X] refactor Copyright into CRHeader (with a chPackage) and CRLicense (with a crPackage)
- refactor so that homepage comes from source overriding package
- refactor so that shordesc from translations overriding source overriding package
- refactor so that things get assembled into a big ass object writing to various entries
- add a (Debian changelog author) to license verifier
- make sure the db creation works as expected (especially primary key on conflict replace
- utilise indexes in db
-}