path: root/src/FSD/Types.hs

{-
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
-}