path: root/src/FSD/Db.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 TypeOperators #-}

module FSD.Db where

import Control.Monad
import FSD.Copyright
import Data.Text (Text)
import Data.Text qualified as T
import Database.SQLite.Simple
import FSD.Types

newtype FsDb = FsDb {getConn :: Connection}

withFsDb :: FilePath -> (FsDb -> IO a) -> IO a
withFsDb path f = withConnection path (f . FsDb)

-- creations

initConn :: FsDb -> IO ()
initConn (FsDb conn) = do
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS sources \
    \( package TEXT NOT NULL PRIMARY KEY ON CONFLICT REPLACE \
    \, version TEXT NOT NULL \
    \, file    TEXT NOT NULL \
    \, homepage  TEXT \
    \)"
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS packages \
    \( package TEXT NOT NULL PRIMARY KEY ON CONFLICT REPLACE \
    \, version TEXT NOT NULL \
    \, homepage TEXT \
    \, tags TEXT NOT NULL \
    \)"
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS translation \
    \( package TEXT NOT NULL PRIMARY KEY ON CONFLICT REPLACE \
    \, shortDesc  TEXT NOT NULL \
    \, fullDesc TEXT NOT NULL \
    \)"
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS changelog \
    \( package TEXT NOT NULL PRIMARY KEY ON CONFLICT REPLACE \
    \, version TEXT NOT NULL \
    \, author TEXT NOT NULL \
    \, date TEXT NOT NULL \
    \)"
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS copyright \
    \( id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT \
    \, package TEXT NOT NULL \
    \, entryId INTEGER NOT NULL \
    \, copyright TEXT \
    \, license TEXT NOT NULL \
    \, note TEXT \
    \, CONSTRAINT uniqname UNIQUE (package, entryId) ON CONFLICT REPLACE \
    \)"
  execute_
    conn
    "CREATE TABLE IF NOT EXISTS upstream \
    \( package TEXT NOT NULL PRIMARY KEY ON CONFLICT REPLACE \
    \, name TEXT \
    \, contacts TEXT \
    \, sources TEXT \
    \)"

-- insertions

insertSource :: FsDb -> Source -> IO ()
insertSource (FsDb conn) source =
  execute conn "INSERT INTO sources VALUES (?,?,?,?)" source

insertPackage :: FsDb -> Package -> IO ()
insertPackage (FsDb conn) package =
  execute conn "INSERT INTO packages VALUES (?,?,?,?)" package

insertTranslation :: FsDb -> Translation -> IO ()
insertTranslation (FsDb conn) translation =
  execute conn "INSERT INTO translation VALUES (?,?,?)" translation

insertFSDChangeLogEntry :: FsDb -> FSDChangeLogEntry -> IO ()
insertFSDChangeLogEntry (FsDb conn) change =
  execute conn "INSERT INTO changelog VALUES (?,?,?,?)" change

insertCopyright :: FsDb -> Copyright -> IO ()
insertCopyright db (Copyright package licenses) =
  zipWithM_ (insertLicense db package) [0 ..] licenses

insertUpstream :: FsDb -> Upstream -> IO ()
insertUpstream (FsDb conn) upstream =
  execute conn "INSERT INTO upstream VALUES (?,?,?,?)" upstream

insertLicense :: FsDb -> Text -> Int -> LicenseInfo -> IO ()
insertLicense (FsDb conn) package idx (LicenseInfo copyright license note) =
  execute
    conn
    "INSERT INTO copyright (package,entryId,copyright,license,note) \
    \VALUES (?,?,?,?,?)"
    (package, idx, copyright, license, note)

-- queries
getDbAll :: FsDb -> IO [Source :. Package :. Translation :. FSDChangeLogEntry :. Upstream]
getDbAll (FsDb conn) =
  query_
    conn
    "SELECT sources.*,packages.*,translation.*,changelog.*,upstream.* \
    \FROM sources JOIN packages USING (package,version)\
    \             JOIN changelog USING (package,version)\
    \             JOIN translation USING (package)\
    \             JOIN upstream USING (package)\
    \"

getDbPkgNames :: FsDb -> IO [Text]
getDbPkgNames (FsDb conn) = do
  rows <- query_ conn
          "SELECT DISTINCT package\
          \ FROM sources JOIN packages USING (package,version)\
          \              JOIN changelog USING (package,version)\
          \              JOIN translation USING (package)\
          \              JOIN upstream USING (package)\
          \              JOIN copyright USING (package)\
          \"
  return $ fromOnly <$> rows

getDbAllTypes :: Text -> FsDb -> IO (Maybe (Source :. Package :. Translation :. FSDChangeLogEntry :. Upstream))
getDbAllTypes pkgName (FsDb conn) = do
  results <- query
             conn
             "SELECT sources.*,packages.*,translation.*,changelog.*,upstream.* \
             \FROM sources JOIN packages USING (package,version)\
             \             JOIN changelog USING (package,version)\
             \             JOIN translation USING (package)\
             \             JOIN upstream USING (package) \
             \WHERE package = ?\
             \" (Only pkgName)
  return $ case results of
    [source] -> Just source
    otherwise -> Nothing

getDbSource :: Text -> FsDb -> IO (Maybe Source)
getDbSource pkgName (FsDb conn) = do
  results <- query conn "SELECT * FROM sources WHERE package = ?" (Only pkgName)
  return $ case results of
    [source] -> Just source
    otherwise -> Nothing

getDbPackage :: Text -> FsDb -> IO (Maybe Package)
getDbPackage pkgName (FsDb conn) = do
  results <- query conn "SELECT * FROM packages WHERE package = ?" (Only pkgName)
  return $ case results of
    [package] -> Just package
    otherwise -> Nothing

getDbTranslation :: Text -> FsDb -> IO (Maybe Translation)
getDbTranslation pkgName (FsDb conn) = do
  results <- query conn "SELECT * FROM translation WHERE package = ?" (Only pkgName)
  return $ case results of
    [translation] -> Just translation
    otherwise -> Nothing

getDbFSDChangeLogEntry :: Text -> FsDb -> IO (Maybe FSDChangeLogEntry)
getDbFSDChangeLogEntry pkgName (FsDb conn) = do
  results <- query conn "SELECT * FROM changelog WHERE package = ?" (Only pkgName)
  return $ case results of
    [entry] -> Just entry
    otherwise -> Nothing

getDbUpstream :: Text -> FsDb -> IO (Maybe Upstream)
getDbUpstream pkgName (FsDb conn) = do
  results <- query conn "SELECT * FROM upstream WHERE package = ?" (Only pkgName)
  return $ case results of
    [upstream] -> Just upstream
    otherwise -> Nothing

getDbCopyright :: Text -> FsDb -> IO (Maybe Copyright)
getDbCopyright pkgName (FsDb conn) = do
  results <-
    query
      conn
      "SELECT copyright,license,note FROM copyright WHERE package = ?"
      (Only pkgName) ::
      IO [LicenseInfo]
  return $
    if (null results) then Nothing else Just $ Copyright pkgName results