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