diff options
Diffstat (limited to 'src/FSD/Db.hs')
| -rw-r--r-- | src/FSD/Db.hs | 211 |
1 files changed, 211 insertions, 0 deletions
diff --git a/src/FSD/Db.hs b/src/FSD/Db.hs new file mode 100644 index 0000000..38a822c --- /dev/null +++ b/src/FSD/Db.hs @@ -0,0 +1,211 @@ +{- +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 |