From c5135cddee33c4261ddc75b88741b5175f96ad29 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Tue, 29 Oct 2024 09:45:40 +0100 Subject: [PATCH 01/11] started Bib API --- src/Poseidon/BibFile.hs | 14 ++++++++++++++ src/Poseidon/CLI/Serve.hs | 7 +++++++ src/Poseidon/ServerClient.hs | 20 ++++++++++++++++++++ 3 files changed, 41 insertions(+) diff --git a/src/Poseidon/BibFile.hs b/src/Poseidon/BibFile.hs index 3310fbfa4..b568d658d 100644 --- a/src/Poseidon/BibFile.hs +++ b/src/Poseidon/BibFile.hs @@ -6,6 +6,8 @@ import Poseidon.Utils (PoseidonException (..), import Control.Exception (throwIO) import Control.Monad (forM_, liftM2, liftM3) +import Data.Aeson (FromJSON, ToJSON (..), object, parseJSON, + toJSON, withObject, (.:), (.=)) import System.IO (IOMode (..), hPutStrLn, withFile) import Text.Parsec (between, char, many, many1, @@ -30,6 +32,18 @@ instance Eq BibEntry where instance Ord BibEntry where (BibEntry _ i1 _) `compare` (BibEntry _ i2 _) = i1 `compare` i2 +instance ToJSON BibEntry where + toJSON e = object [ + "bibEntryType" .= bibEntryType e, + "bibEntryId" .= bibEntryId e, + "bibEntryFields" .= bibEntryFields e] + +instance FromJSON BibEntry where + parseJSON = withObject "BibEntry" $ \v -> BibEntry + <$> v .: "bibEntryType" + <*> v .: "bibEntryId" + <*> v .: "bibEntryFields" + type BibTeX = [BibEntry] dummyBibEntry :: BibEntry diff --git a/src/Poseidon/CLI/Serve.hs b/src/Poseidon/CLI/Serve.hs index 468faff3e..c518c35f9 100644 --- a/src/Poseidon/CLI/Serve.hs +++ b/src/Poseidon/CLI/Serve.hs @@ -130,6 +130,13 @@ runServer (ServeOptions archBaseDirs maybeZipPath port ignoreChecksums certFiles Nothing -> getExtendedIndividualInfo pacs (AddJannoColList []) let retData = ApiReturnExtIndividualInfo indInfo return $ ServerApiReturnType [] (Just retData) + + get "/bibliography" . conditionOnClientVersion $ do + logRequest logA + pacs <- getItemFromArchiveStore archiveStore + let bibEntries = concatMap posPacBib pacs + let retData = ApiReturnBibInfo bibEntries + return $ ServerApiReturnType [] (Just retData) -- API for retreiving package zip files when (isJust maybeZipPath) . get "/zip_file/:package_name" $ do diff --git a/src/Poseidon/ServerClient.hs b/src/Poseidon/ServerClient.hs index 9a5c2c9e3..f24724458 100644 --- a/src/Poseidon/ServerClient.hs +++ b/src/Poseidon/ServerClient.hs @@ -13,6 +13,7 @@ module Poseidon.ServerClient ( ) where import Paths_poseidon_hs (version) +import Poseidon.BibFile (BibEntry (..)) import Poseidon.EntityTypes (HasNameAndVersion (..), IndividualInfo (..), IndividualInfoCollection, @@ -75,6 +76,7 @@ instance FromJSON ServerApiReturnType where data ApiReturnData = ApiReturnPackageInfo [PackageInfo] | ApiReturnGroupInfo [GroupInfo] | ApiReturnExtIndividualInfo [ExtendedIndividualInfo] + | ApiReturnBibInfo [BibEntry] instance ToJSON ApiReturnData where toJSON (ApiReturnPackageInfo pacInfo) = @@ -92,6 +94,11 @@ instance ToJSON ApiReturnData where "constructor" .= String "ApiReturnExtIndividualInfo", "extIndInfo" .= indInfo ] + toJSON (ApiReturnBibInfo bibInfo) = + object [ + "constructor" .= String "ApiReturnBibInfo", + "bibEntries" .= bibInfo + ] instance FromJSON ApiReturnData where parseJSON = withObject "ApiReturnData" $ \v -> do @@ -100,6 +107,7 @@ instance FromJSON ApiReturnData where "ApiReturnPackageInfo" -> ApiReturnPackageInfo <$> v .: "packageInfo" "ApiReturnGroupInfo" -> ApiReturnGroupInfo <$> v .: "groupInfo" "ApiReturnExtIndividualInfo" -> ApiReturnExtIndividualInfo <$> v .: "extIndInfo" + "ApiReturnBibInfo" -> ApiReturnBibInfo <$> v .: "bibEntries" _ -> error $ "cannot parse ApiReturnType with constructor " ++ constr @@ -221,3 +229,15 @@ extIndInfo2IndInfoCollection extIndInfos = -- type needed to specify additional Janno Columns to be queried from packages data AddJannoColSpec = AddJannoColList [String] | AddJannoColAll +data BibliographyInfo = BibliographyInfo { + bibInfoPackageNames :: [PacNameAndVersion], + bibInfoNrSamples :: Int, + bibInfoBibEntry :: BibEntry +} + +instance ToJSON BibliographyInfo where + toJSON e = object [ + "packageNames" .= bibInfoPackageNames e, + "nrSamples" .= bibInfoNrSamples e, + "bibEntry" .= bibInfoBibEntry e + ] \ No newline at end of file From d562b672cc5211f415136e519a00d99f84a9b2f2 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Tue, 19 Nov 2024 21:31:30 +0100 Subject: [PATCH 02/11] finished API, first tests work --- src/Poseidon/EntityTypes.hs | 7 ++++++- src/Poseidon/ServerClient.hs | 3 +-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Poseidon/EntityTypes.hs b/src/Poseidon/EntityTypes.hs index 54ff94b40..46f9c9963 100644 --- a/src/Poseidon/EntityTypes.hs +++ b/src/Poseidon/EntityTypes.hs @@ -29,7 +29,7 @@ import Control.Monad (forM, forM_, unless, when) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), - withText) + withText, object, (.=)) import Data.Aeson.Types (Parser) import Data.Char (isSpace) import Data.List (groupBy, intercalate, nub, sortOn, @@ -85,6 +85,11 @@ instance HasNameAndVersion PacNameAndVersion where instance Show PacNameAndVersion where show a = "*" ++ renderNameWithVersion a ++ "*" +instance ToJSON PacNameAndVersion where + toJSON e = object [ + "packageName" .= panavName e, + "packageVersion" .= panavVersion e] + -- | a function to normalise any instance of HasNameAndVersion to the minimal concrete type PacNameAndVersion makePacNameAndVersion :: (HasNameAndVersion a) => a -> PacNameAndVersion makePacNameAndVersion a = PacNameAndVersion (getPacName a) (getPacVersion a) diff --git a/src/Poseidon/ServerClient.hs b/src/Poseidon/ServerClient.hs index f24724458..cee47510b 100644 --- a/src/Poseidon/ServerClient.hs +++ b/src/Poseidon/ServerClient.hs @@ -239,5 +239,4 @@ instance ToJSON BibliographyInfo where toJSON e = object [ "packageNames" .= bibInfoPackageNames e, "nrSamples" .= bibInfoNrSamples e, - "bibEntry" .= bibInfoBibEntry e - ] \ No newline at end of file + "bibEntry" .= bibInfoBibEntry e ] \ No newline at end of file From 64fbf71c142311d1755ed85693d360e4882cd9a3 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Wed, 20 Nov 2024 17:40:06 +0100 Subject: [PATCH 03/11] bibliography API works --- src/Poseidon/BibFile.hs | 14 --- src/Poseidon/CLI/List.hs | 15 +-- .../CLI/OptparseApplicativeParsers.hs | 6 +- src/Poseidon/CLI/Serve.hs | 21 ++-- src/Poseidon/EntityTypes.hs | 7 +- src/Poseidon/Package.hs | 50 +++++++++- src/Poseidon/ServerClient.hs | 96 +++++++++++++------ .../GoldenTestsRunCommands.hs | 10 +- 8 files changed, 142 insertions(+), 77 deletions(-) diff --git a/src/Poseidon/BibFile.hs b/src/Poseidon/BibFile.hs index b568d658d..3310fbfa4 100644 --- a/src/Poseidon/BibFile.hs +++ b/src/Poseidon/BibFile.hs @@ -6,8 +6,6 @@ import Poseidon.Utils (PoseidonException (..), import Control.Exception (throwIO) import Control.Monad (forM_, liftM2, liftM3) -import Data.Aeson (FromJSON, ToJSON (..), object, parseJSON, - toJSON, withObject, (.:), (.=)) import System.IO (IOMode (..), hPutStrLn, withFile) import Text.Parsec (between, char, many, many1, @@ -32,18 +30,6 @@ instance Eq BibEntry where instance Ord BibEntry where (BibEntry _ i1 _) `compare` (BibEntry _ i2 _) = i1 `compare` i2 -instance ToJSON BibEntry where - toJSON e = object [ - "bibEntryType" .= bibEntryType e, - "bibEntryId" .= bibEntryId e, - "bibEntryFields" .= bibEntryFields e] - -instance FromJSON BibEntry where - parseJSON = withObject "BibEntry" $ \v -> BibEntry - <$> v .: "bibEntryType" - <*> v .: "bibEntryId" - <*> v .: "bibEntryFields" - type BibTeX = [BibEntry] dummyBibEntry :: BibEntry diff --git a/src/Poseidon/CLI/List.hs b/src/Poseidon/CLI/List.hs index 9bcc22e64..bcf846200 100644 --- a/src/Poseidon/CLI/List.hs +++ b/src/Poseidon/CLI/List.hs @@ -9,7 +9,7 @@ import Poseidon.Package (PackageReadOptions (..), getExtendedIndividualInfo, packagesToPackageInfos, readPoseidonPackageCollection) -import Poseidon.ServerClient (AddJannoColSpec (..), +import Poseidon.ServerClient (AddColSpec (..), ApiReturnData (..), ArchiveEndpoint (..), ExtendedIndividualInfo (..), @@ -39,7 +39,8 @@ data RepoLocationSpec = RepoLocal [FilePath] | RepoRemote ArchiveEndpoint -- | A datatype to represent the options what to list data ListEntity = ListPackages | ListGroups - | ListIndividuals AddJannoColSpec + | ListIndividuals AddColSpec + | ListBibliography AddColSpec -- | The main function running the list command runList :: ListOptions -> PoseidonIO () @@ -95,9 +96,9 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do RepoRemote (ArchiveEndpoint remoteURL archive) -> do logInfo "Downloading individual data from server" let addJannoColFlag = case addJannoColSpec of - AddJannoColAll -> "&additionalJannoColumns=ALL" - AddJannoColList [] -> "" - AddJannoColList moreJannoColumns -> "&additionalJannoColumns=" ++ intercalate "," moreJannoColumns + AddColAll -> "&additionalJannoColumns=ALL" + AddColList [] -> "" + AddColList moreJannoColumns -> "&additionalJannoColumns=" ++ intercalate "," moreJannoColumns apiReturn <- processApiResponse (remoteURL ++ "/individuals" ++ qDefault archive ++ addJannoColFlag) False case apiReturn of ApiReturnExtIndividualInfo indInfo -> return indInfo @@ -114,7 +115,7 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do -- we only output this warning if the columns were requested explicitly. Not if -- all columns were requested. We consider such an "all" request to mean "all columns that are present". case addJannoColSpec of - AddJannoColList (_:_) -> do + AddColList (_:_) -> do forM_ (zip [0..] addJannoCols) $ \(i, columnKey) -> do -- check entries in all individuals for that key let nonEmptyEntries = catMaybes [snd (entries !! i) | ExtendedIndividualInfo _ _ _ _ entries <- extIndInfos] @@ -129,6 +130,8 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do showMaybeVersion (getPacVersion i), show isLatest] ++ map (fromMaybe "n/a" . snd) addColumnEntries return (tableH, tableB) + ListBibliography _ -> do + return undefined if rawOutput then liftIO $ putStrLn $ intercalate "\n" [intercalate "\t" row | row <- tableH:tableB] else do diff --git a/src/Poseidon/CLI/OptparseApplicativeParsers.hs b/src/Poseidon/CLI/OptparseApplicativeParsers.hs index 3011ce820..6434105f6 100644 --- a/src/Poseidon/CLI/OptparseApplicativeParsers.hs +++ b/src/Poseidon/CLI/OptparseApplicativeParsers.hs @@ -21,7 +21,7 @@ import Poseidon.GenotypeData (GenoDataSource (..), GenotypeDataSpec (..), GenotypeFileSpec (..), SNPSetSpec (..)) -import Poseidon.ServerClient (AddJannoColSpec (..), +import Poseidon.ServerClient (AddColSpec (..), ArchiveEndpoint (..)) import Poseidon.Utils (ErrorLength (..), LogMode (..), TestMode (..), @@ -625,8 +625,8 @@ parseListEntity = parseListPackages <|> parseListGroups <|> (parseListIndividual parseListIndividualsDummy = OP.flag' () ( OP.long "individuals" <> OP.help "List all individuals/samples.") - parseListIndividualsExtraCols = ListIndividuals <$> (parseAllJannoCols <|> (AddJannoColList <$> OP.many parseExtraCol)) - parseAllJannoCols = OP.flag' AddJannoColAll (OP.long "fullJanno" <> OP.help "output all Janno Columns") + parseListIndividualsExtraCols = ListIndividuals <$> (parseAllJannoCols <|> (AddColList <$> OP.many parseExtraCol)) + parseAllJannoCols = OP.flag' AddColAll (OP.long "fullJanno" <> OP.help "output all Janno Columns") parseExtraCol = OP.strOption ( OP.short 'j' <> OP.long "jannoColumn" <> diff --git a/src/Poseidon/CLI/Serve.hs b/src/Poseidon/CLI/Serve.hs index c518c35f9..818d8a608 100644 --- a/src/Poseidon/CLI/Serve.hs +++ b/src/Poseidon/CLI/Serve.hs @@ -14,9 +14,10 @@ import Poseidon.Package (PackageReadOptions (..), getAllGroupInfo, getExtendedIndividualInfo, packagesToPackageInfos, - readPoseidonPackageCollection) + readPoseidonPackageCollection, + getBibliographyInfo) import Poseidon.PoseidonVersion (minimalRequiredClientVersion) -import Poseidon.ServerClient (AddJannoColSpec (..), +import Poseidon.ServerClient (AddColSpec (..), ApiReturnData (..), ServerApiReturnType (..)) import Poseidon.Utils (LogA, PoseidonIO, envLogAction, @@ -123,19 +124,25 @@ runServer (ServeOptions archBaseDirs maybeZipPath port ignoreChecksums certFiles pacs <- getItemFromArchiveStore archiveStore maybeAdditionalColumnsString <- (Just <$> param "additionalJannoColumns") `rescue` (\_ -> return Nothing) indInfo <- case maybeAdditionalColumnsString of - Just "ALL" -> getExtendedIndividualInfo pacs AddJannoColAll -- Nothing means all Janno Columns + Just "ALL" -> getExtendedIndividualInfo pacs AddColAll -- Nothing means all Janno Columns Just additionalColumnsString -> let additionalColumnNames = splitOn "," additionalColumnsString - in getExtendedIndividualInfo pacs (AddJannoColList additionalColumnNames) - Nothing -> getExtendedIndividualInfo pacs (AddJannoColList []) + in getExtendedIndividualInfo pacs (AddColList additionalColumnNames) + Nothing -> getExtendedIndividualInfo pacs (AddColList []) let retData = ApiReturnExtIndividualInfo indInfo return $ ServerApiReturnType [] (Just retData) get "/bibliography" . conditionOnClientVersion $ do logRequest logA pacs <- getItemFromArchiveStore archiveStore - let bibEntries = concatMap posPacBib pacs - let retData = ApiReturnBibInfo bibEntries + maybeAdditionalBibFieldsString <- (Just <$> param "additionalBibColumns") `rescue` (\_ -> return Nothing) + bibInfo <- case maybeAdditionalBibFieldsString of + Just "ALL" -> getBibliographyInfo pacs AddColAll -- Nothing means all Janno Columns + Just additionalBibFieldsString -> + let additionalBibFields = splitOn "," additionalBibFieldsString + in getBibliographyInfo pacs (AddColList additionalBibFields) + Nothing -> getBibliographyInfo pacs (AddColList []) + let retData = ApiReturnBibInfo bibInfo return $ ServerApiReturnType [] (Just retData) -- API for retreiving package zip files diff --git a/src/Poseidon/EntityTypes.hs b/src/Poseidon/EntityTypes.hs index 46f9c9963..54ff94b40 100644 --- a/src/Poseidon/EntityTypes.hs +++ b/src/Poseidon/EntityTypes.hs @@ -29,7 +29,7 @@ import Control.Monad (forM, forM_, unless, when) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), - withText, object, (.=)) + withText) import Data.Aeson.Types (Parser) import Data.Char (isSpace) import Data.List (groupBy, intercalate, nub, sortOn, @@ -85,11 +85,6 @@ instance HasNameAndVersion PacNameAndVersion where instance Show PacNameAndVersion where show a = "*" ++ renderNameWithVersion a ++ "*" -instance ToJSON PacNameAndVersion where - toJSON e = object [ - "packageName" .= panavName e, - "packageVersion" .= panavVersion e] - -- | a function to normalise any instance of HasNameAndVersion to the minimal concrete type PacNameAndVersion makePacNameAndVersion :: (HasNameAndVersion a) => a -> PacNameAndVersion makePacNameAndVersion a = PacNameAndVersion (getPacName a) (getPacVersion a) diff --git a/src/Poseidon/Package.hs b/src/Poseidon/Package.hs index d635b269b..72c7b6141 100644 --- a/src/Poseidon/Package.hs +++ b/src/Poseidon/Package.hs @@ -26,11 +26,13 @@ module Poseidon.Package ( packagesToPackageInfos, getAllGroupInfo, validateGeno, - filterToRelevantPackages + filterToRelevantPackages, + getBibliographyInfo ) where import Poseidon.BibFile (BibEntry (..), BibTeX, readBibTeXFile) +import Poseidon.ColumnTypes (JannoPublication (..)) import Poseidon.Contributor (ContributorSpec (..)) import Poseidon.EntityTypes (EntitySpec, HasNameAndVersion (..), IndividualInfo (..), @@ -59,7 +61,8 @@ import Poseidon.SequencingSource (SSFLibraryBuilt (..), SSFUDG (..), SeqSourceRow (..), SeqSourceRows (..), readSeqSourceFile) -import Poseidon.ServerClient (AddJannoColSpec (..), +import Poseidon.ServerClient (AddColSpec (..), + BibliographyInfo (..), ExtendedIndividualInfo (..), GroupInfo (..), PackageInfo (..)) import Poseidon.Utils (LogA, PoseidonException (..), @@ -90,6 +93,7 @@ import Data.List (elemIndex, group, groupBy, (\\)) import Data.Maybe (catMaybes, fromMaybe, isNothing, mapMaybe) +import Data.Text (unpack) import Data.Time (Day, UTCTime (..), getCurrentTime) import qualified Data.Vector as V import Data.Version (Version (..), makeVersion) @@ -838,16 +842,16 @@ getJointIndividualInfo packages = do return (map fst . concat $ indInfoLatestPairs, map snd . concat $ indInfoLatestPairs) -getExtendedIndividualInfo :: (MonadThrow m) => [PoseidonPackage] -> AddJannoColSpec -> m [ExtendedIndividualInfo] +getExtendedIndividualInfo :: (MonadThrow m) => [PoseidonPackage] -> AddColSpec -> m [ExtendedIndividualInfo] getExtendedIndividualInfo allPackages addJannoColSpec = sequence $ do -- list monad pac <- allPackages -- outer loop (automatically concatenating over inner loops) jannoRow <- getJannoRowsFromPac pac -- inner loop let name = jPoseidonID jannoRow groups = map show $ getListColumn . jGroupName $ jannoRow colNames = case addJannoColSpec of - AddJannoColAll -> jannoHeaderString \\ ["Poseidon_ID", "Group_Name"] -- Nothing means all Janno columns + AddColAll -> jannoHeaderString \\ ["Poseidon_ID", "Group_Name"] -- Nothing means all Janno columns -- except for these two which are already explicit - AddJannoColList c -> c + AddColList c -> c additionalColumnEntries = [(k, BSC.unpack <$> toNamedRecord jannoRow HM.!? BSC.pack k) | k <- colNames] isLatest <- isLatestInCollection allPackages pac -- this lives in monad m -- double-return for m and then list. @@ -859,3 +863,39 @@ filterToRelevantPackages entities packages = do indInfoCollection <- getJointIndividualInfo packages relevantPacs <- determineRelevantPackages entities indInfoCollection return $ filter (\p -> makePacNameAndVersion p `elem` relevantPacs) packages + +-- data BibliographyInfo = BibliographyInfo { +-- bibInfoPac :: PacNameAndVersion, +-- bibInfoIsLatest :: Bool, +-- bibInfoNrSamples :: Int, +-- bibInfoKey :: String, +-- bibInfoTitle :: Maybe String, +-- bibInfoAuthor :: Maybe String, +-- bibInfoYear :: Maybe String, +-- bibInfoJournal :: Maybe String, +-- bibInfoDoi :: Maybe String, +-- bibInfoAddCols :: [(String, Maybe String)] +-- } + +getBibliographyInfo :: (MonadThrow m) => [PoseidonPackage] -> AddColSpec -> m [BibliographyInfo] +getBibliographyInfo allPackages addColSpec = sequence $ do + pac <- allPackages -- loop over packages, concatenating inner loops + (BibEntry _ bibId bibFields) <- posPacBib pac --loop over bib-entries + let nrSamples = length $ do -- list monad over samples + jannoRow <- getJannoRowsFromPac pac + let bibKeys = case jPublication jannoRow of + Nothing -> [] + Just jannoPubList -> map (\(JannoPublication p) -> unpack p) $ getListColumn jannoPubList + True <- return $ bibId `elem` bibKeys + return () + isLatest <- isLatestInCollection allPackages pac + let addBibEntries = case addColSpec of + -- with "all" we include all existing additional bib-entries except for the canonical ones that we anyway look up. + AddColAll -> [(k, Just v) | (k, v) <- bibFields, k `notElem` ["title", "author", "year", "journal", "doi"]] + -- with a selecton of colNames we just query the bib-fields for those exact fields. + AddColList colNames -> [(colName, colName `lookup` bibFields) | colName <- colNames] + return . return $ BibliographyInfo (makePacNameAndVersion pac) isLatest nrSamples bibId ("title" `lookup` bibFields) + ("author" `lookup` bibFields) ("year" `lookup` bibFields) ("journal" `lookup` bibFields) + ("doi" `lookup` bibFields) addBibEntries + + diff --git a/src/Poseidon/ServerClient.hs b/src/Poseidon/ServerClient.hs index cee47510b..64b506d0f 100644 --- a/src/Poseidon/ServerClient.hs +++ b/src/Poseidon/ServerClient.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE OverloadedStrings #-} module Poseidon.ServerClient ( @@ -9,11 +10,11 @@ module Poseidon.ServerClient ( PackageInfo (..), GroupInfo (..), ExtendedIndividualInfo(..), extIndInfo2IndInfoCollection, qDefault, qArchive, qPacVersion, (+&+), - AddJannoColSpec(..) + BibliographyInfo(..), + AddColSpec(..) ) where import Paths_poseidon_hs (version) -import Poseidon.BibFile (BibEntry (..)) import Poseidon.EntityTypes (HasNameAndVersion (..), IndividualInfo (..), IndividualInfoCollection, @@ -24,9 +25,10 @@ import Poseidon.Utils (PoseidonException (..), PoseidonIO, import Control.Exception (catch, throwIO) import Control.Monad (forM_, unless) import Control.Monad.IO.Class (liftIO) -import Data.Aeson (FromJSON, ToJSON (..), Value (String), +import Data.Aeson (FromJSON, ToJSON (..), Value (..), eitherDecode', object, parseJSON, - toJSON, withObject, (.:), (.=)) + toJSON, withObject, (.:), (.:?), (.=)) +import qualified Data.Aeson.KeyMap (filter) import Data.Time (Day) import Data.Version (Version, showVersion) import Network.HTTP.Conduit (simpleHttp) @@ -63,20 +65,25 @@ data ServerApiReturnType = ServerApiReturnType { instance ToJSON ServerApiReturnType where toJSON (ServerApiReturnType messages response) = - object [ + removeNulls $ object [ "serverMessages" .= messages, "serverResponse" .= response ] +-- simple function to filter out Nulls from JSON Objects, for more efficient encoding. +removeNulls :: Value -> Value +removeNulls (Object kvmap) = Object $ Data.Aeson.KeyMap.filter (/= Null) kvmap +removeNulls _ = error "Client usage error, removeNulls should only be applied to objects" + instance FromJSON ServerApiReturnType where parseJSON = withObject "ServerApiReturnType" $ \v -> ServerApiReturnType <$> v .: "serverMessages" - <*> v .: "serverResponse" + <*> v .:? "serverResponse" data ApiReturnData = ApiReturnPackageInfo [PackageInfo] | ApiReturnGroupInfo [GroupInfo] | ApiReturnExtIndividualInfo [ExtendedIndividualInfo] - | ApiReturnBibInfo [BibEntry] + | ApiReturnBibInfo [BibliographyInfo] instance ToJSON ApiReturnData where toJSON (ApiReturnPackageInfo pacInfo) = @@ -126,10 +133,10 @@ instance HasNameAndVersion PackageInfo where instance ToJSON PackageInfo where toJSON (PackageInfo (PacNameAndVersion n v) isLatest posVersion description lastModified nrIndividuals) = - object [ + removeNulls $ object [ "packageTitle" .= n, "packageVersion" .= v, - "isLatest" .= isLatest, + "isLatest" .= isLatest, "poseidonVersion" .= posVersion, "description" .= description, "lastModified" .= lastModified, @@ -138,11 +145,11 @@ instance ToJSON PackageInfo where instance FromJSON PackageInfo where parseJSON = withObject "PackageInfo" $ \v -> PackageInfo - <$> (PacNameAndVersion <$> (v .: "packageTitle") <*> (v .: "packageVersion")) + <$> (PacNameAndVersion <$> (v .: "packageTitle") <*> (v .:? "packageVersion")) <*> v .: "isLatest" <*> v .: "poseidonVersion" - <*> v .: "description" - <*> v .: "lastModified" + <*> v .:? "description" + <*> v .:? "lastModified" <*> v .: "nrIndividuals" data GroupInfo = GroupInfo @@ -154,7 +161,7 @@ data GroupInfo = GroupInfo instance ToJSON GroupInfo where toJSON (GroupInfo name (PacNameAndVersion pacTitle pacVersion) isLatest nrIndividuals) = - object [ + removeNulls $ object [ "groupName" .= name, "packageTitle" .= pacTitle, "packageVersion" .= pacVersion, @@ -166,7 +173,7 @@ instance FromJSON GroupInfo where parseJSON = withObject "GroupInfo" $ \v -> do groupName <- v .: "groupName" packageTitle <- v .: "packageTitle" - packageVersion <- v .: "packageVersion" + packageVersion <- v .:? "packageVersion" isLatest <- v .: "isLatest" nrIndividuals <- v .: "nrIndividuals" return $ GroupInfo groupName (PacNameAndVersion packageTitle packageVersion) isLatest nrIndividuals @@ -189,20 +196,19 @@ instance HasNameAndVersion ExtendedIndividualInfo where getPacVersion = getPacVersion . extIndInfoPac instance ToJSON ExtendedIndividualInfo where - toJSON e = - object [ - "poseidonID" .= extIndInfoName e, - "groupNames" .= extIndInfoGroups e, - "packageTitle" .= (getPacName . extIndInfoPac $ e), - "packageVersion" .= (getPacVersion . extIndInfoPac $ e), - "isLatest" .= extIndInfoIsLatest e, - "additionalJannoColumns" .= extIndInfoAddCols e] + toJSON e = removeNulls $ object [ + "poseidonID" .= extIndInfoName e, + "groupNames" .= extIndInfoGroups e, + "packageTitle" .= (getPacName . extIndInfoPac $ e), + "packageVersion" .= (getPacVersion . extIndInfoPac $ e), + "isLatest" .= extIndInfoIsLatest e, + "additionalJannoColumns" .= extIndInfoAddCols e] instance FromJSON ExtendedIndividualInfo where parseJSON = withObject "ExtendedIndividualInfo" $ \v -> ExtendedIndividualInfo <$> v .: "poseidonID" <*> v .: "groupNames" - <*> (PacNameAndVersion <$> (v .: "packageTitle") <*> (v .: "packageVersion")) + <*> (PacNameAndVersion <$> (v .: "packageTitle") <*> (v .:? "packageVersion")) <*> v .: "isLatest" <*> v .: "additionalJannoColumns" @@ -227,16 +233,44 @@ extIndInfo2IndInfoCollection extIndInfos = in (indInfos, areLatest) -- type needed to specify additional Janno Columns to be queried from packages -data AddJannoColSpec = AddJannoColList [String] | AddJannoColAll +data AddColSpec = AddColList [String] | AddColAll data BibliographyInfo = BibliographyInfo { - bibInfoPackageNames :: [PacNameAndVersion], - bibInfoNrSamples :: Int, - bibInfoBibEntry :: BibEntry + bibInfoPac :: PacNameAndVersion, + bibInfoIsLatest :: Bool, + bibInfoNrSamples :: Int, + bibInfoKey :: String, + bibInfoTitle :: Maybe String, + bibInfoAuthor :: Maybe String, + bibInfoYear :: Maybe String, + bibInfoJournal :: Maybe String, + bibInfoDoi :: Maybe String, + bibInfoAddCols :: [(String, Maybe String)] } instance ToJSON BibliographyInfo where - toJSON e = object [ - "packageNames" .= bibInfoPackageNames e, - "nrSamples" .= bibInfoNrSamples e, - "bibEntry" .= bibInfoBibEntry e ] \ No newline at end of file + toJSON e = removeNulls $ object [ + "packageTitle" .= (getPacName . bibInfoPac $ e), + "packageVersion" .= (getPacVersion . bibInfoPac $ e), + "isLatest" .= bibInfoIsLatest e, + "nrSamples" .= bibInfoNrSamples e, + "bibKey" .= bibInfoKey e, + "bibTitle" .= bibInfoTitle e, + "bibAuthor" .= bibInfoAuthor e, + "bibYear" .= bibInfoYear e, + "bibJournal" .= bibInfoJournal e, + "bibDoi" .= bibInfoDoi e, + "additionalBibEntries" .= bibInfoAddCols e ] + +instance FromJSON BibliographyInfo where + parseJSON = withObject "BibliographyInfo" $ \v -> BibliographyInfo + <$> (PacNameAndVersion <$> (v .: "packageTitle") <*> (v .:? "packageVersion")) + <*> v .: "isLatest" + <*> v .: "nrSamples" + <*> v .: "bibKey" + <*> v .:? "bibTitle" + <*> v .:? "bibAuthor" + <*> v .:? "bibYear" + <*> v .:? "bibJournal" + <*> v .:? "bibDoi" + <*> v .: "additionalBibEntries" diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index 41b0027ad..ec86d05c8 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -36,7 +36,7 @@ import Poseidon.GenotypeData (GenoDataSource (..), GenotypeDataSpec (..), GenotypeFileSpec (..), SNPSetSpec (..)) -import Poseidon.ServerClient (AddJannoColSpec (..), +import Poseidon.ServerClient (AddColSpec (..), ArchiveEndpoint (..)) import Poseidon.Utils (LogMode (..), TestMode (..), getChecksum, testLog, @@ -363,7 +363,7 @@ testPipelineList testDir checkFilePath = do } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts2) "list" 2 let listOpts3 = listOpts1 { - _listListEntity = ListIndividuals (AddJannoColList ["Country", "Nr_SNPs"]) + _listListEntity = ListIndividuals (AddColList ["Country", "Nr_SNPs"]) } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts3) "list" 3 let listOpts4 = listOpts3 { @@ -375,7 +375,7 @@ testPipelineList testDir checkFilePath = do } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts5) "list" 5 let listOpts6 = listOpts1 { - _listListEntity = ListIndividuals AddJannoColAll + _listListEntity = ListIndividuals AddColAll } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts6) "list" 6 @@ -1221,7 +1221,7 @@ testPipelineListRemote testDir checkFilePath = do } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts2) "listRemote" 2 let listOpts3 = listOpts1 { - _listListEntity = ListIndividuals (AddJannoColList ["Publication"]) + _listListEntity = ListIndividuals (AddColList ["Publication"]) , _listRawOutput = True } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts3) "listRemote" 3 @@ -1236,7 +1236,7 @@ testPipelineListRemote testDir checkFilePath = do runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts4) "listRemote" 4 let listOpts5 = listOpts1 { - _listListEntity = ListIndividuals AddJannoColAll + _listListEntity = ListIndividuals AddColAll , _listRawOutput = True } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts5) "listRemote" 5 From 9e0f1e129713355244a4a7faa60ee12efab89457 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Wed, 20 Nov 2024 18:21:17 +0100 Subject: [PATCH 04/11] finished coding list --bibliography --- src/Poseidon/CLI/List.hs | 61 +++++++++++++++++++++++++++++++++--- src/Poseidon/Package.hs | 13 -------- src/Poseidon/ServerClient.hs | 6 +++- 3 files changed, 61 insertions(+), 19 deletions(-) diff --git a/src/Poseidon/CLI/List.hs b/src/Poseidon/CLI/List.hs index bcf846200..607a57487 100644 --- a/src/Poseidon/CLI/List.hs +++ b/src/Poseidon/CLI/List.hs @@ -8,18 +8,18 @@ import Poseidon.Package (PackageReadOptions (..), getAllGroupInfo, getExtendedIndividualInfo, packagesToPackageInfos, - readPoseidonPackageCollection) + readPoseidonPackageCollection, getBibliographyInfo) import Poseidon.ServerClient (AddColSpec (..), ApiReturnData (..), ArchiveEndpoint (..), ExtendedIndividualInfo (..), GroupInfo (..), PackageInfo (..), - processApiResponse, qDefault) + processApiResponse, qDefault, BibliographyInfo (..)) import Poseidon.Utils (PoseidonIO, logInfo, logWarning) import Control.Monad (forM_, when) import Control.Monad.IO.Class (liftIO) -import Data.List (intercalate, sortOn) +import Data.List (intercalate, sortOn, nub) import Data.Maybe (catMaybes, fromMaybe) import Data.Version (Version, showVersion) @@ -130,8 +130,59 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do showMaybeVersion (getPacVersion i), show isLatest] ++ map (fromMaybe "n/a" . snd) addColumnEntries return (tableH, tableB) - ListBibliography _ -> do - return undefined + ListBibliography addColSpec -> do + bibInfos <- case repoLocation of + RepoRemote (ArchiveEndpoint remoteURL archive) -> do + logInfo "Downloading bibliography data from server" + let addJannoColFlag = case addColSpec of + AddColAll -> "&additionalBibColumns=ALL" + AddColList [] -> "" + AddColList moreBibFields -> "&additionalBibColumns=" ++ intercalate "," moreBibFields + apiReturn <- processApiResponse (remoteURL ++ "/bibliography" ++ qDefault archive ++ addJannoColFlag) False + case apiReturn of + ApiReturnBibInfo bibInfo -> return bibInfo + _ -> error "should not happen" + RepoLocal baseDirs -> do + pacCollection <- readPoseidonPackageCollection pacReadOpts baseDirs + getBibliographyInfo pacCollection addColSpec + + let addBibFieldNames = case addColSpec of + AddColAll -> nub . concatMap (map fst . bibInfoAddCols) $ bibInfos + AddColList names -> names + + -- warning in case the additional Columns do not exist in the entire janno dataset, + -- we only output this warning if the columns were requested explicitly. Not if + -- all columns were requested. We consider such an "all" request to mean "all columns that are present". + case addColSpec of + AddColList (_:_) -> do + forM_ addBibFieldNames $ \bibFieldKey -> do + -- check entries in all individuals for that key + let nonEmptyEntries = do + bibInfo <- bibInfos + Just (Just _) <- return $ bibFieldKey `lookup` bibInfoAddCols bibInfo + return () + when (null nonEmptyEntries) . logWarning $ + "Bibliography field " ++ bibFieldKey ++ "is not present in any bibliography entry" + _ -> return () + + let tableH = ["BibKey", "Title", "Author", "Year", "Journal", "Doi", + "Package", "PackageVersion", "Is Latest", "Nr of samples"] ++ addBibFieldNames + tableB = do + bibInfo <- bibInfos + True <- return (not onlyLatest || bibInfoIsLatest bibInfo) + let addBibFieldColumns = do + bibFieldName <- addBibFieldNames + case bibFieldName `lookup` bibInfoAddCols bibInfo of + Just (Just v) -> return v + _ -> return "" + return $ [bibInfoKey bibInfo, fromMaybe "" $ bibInfoTitle bibInfo, fromMaybe "" $ bibInfoAuthor bibInfo, + fromMaybe "" $ bibInfoYear bibInfo, fromMaybe "" $ bibInfoJournal bibInfo, + fromMaybe "" $ bibInfoDoi bibInfo, getPacName bibInfo, + showMaybeVersion (getPacVersion bibInfo), show (bibInfoIsLatest bibInfo), + show (bibInfoNrSamples bibInfo)] ++ + addBibFieldColumns + return (tableH, tableB) + if rawOutput then liftIO $ putStrLn $ intercalate "\n" [intercalate "\t" row | row <- tableH:tableB] else do diff --git a/src/Poseidon/Package.hs b/src/Poseidon/Package.hs index 72c7b6141..790e501f2 100644 --- a/src/Poseidon/Package.hs +++ b/src/Poseidon/Package.hs @@ -864,19 +864,6 @@ filterToRelevantPackages entities packages = do relevantPacs <- determineRelevantPackages entities indInfoCollection return $ filter (\p -> makePacNameAndVersion p `elem` relevantPacs) packages --- data BibliographyInfo = BibliographyInfo { --- bibInfoPac :: PacNameAndVersion, --- bibInfoIsLatest :: Bool, --- bibInfoNrSamples :: Int, --- bibInfoKey :: String, --- bibInfoTitle :: Maybe String, --- bibInfoAuthor :: Maybe String, --- bibInfoYear :: Maybe String, --- bibInfoJournal :: Maybe String, --- bibInfoDoi :: Maybe String, --- bibInfoAddCols :: [(String, Maybe String)] --- } - getBibliographyInfo :: (MonadThrow m) => [PoseidonPackage] -> AddColSpec -> m [BibliographyInfo] getBibliographyInfo allPackages addColSpec = sequence $ do pac <- allPackages -- loop over packages, concatenating inner loops diff --git a/src/Poseidon/ServerClient.hs b/src/Poseidon/ServerClient.hs index 64b506d0f..0129493ed 100644 --- a/src/Poseidon/ServerClient.hs +++ b/src/Poseidon/ServerClient.hs @@ -246,7 +246,11 @@ data BibliographyInfo = BibliographyInfo { bibInfoJournal :: Maybe String, bibInfoDoi :: Maybe String, bibInfoAddCols :: [(String, Maybe String)] -} +} deriving (Eq) + +instance HasNameAndVersion BibliographyInfo where + getPacName = getPacName . bibInfoPac + getPacVersion = getPacVersion . bibInfoPac instance ToJSON BibliographyInfo where toJSON e = removeNulls $ object [ From e7849e01efb98dc5d6502edf054a2fbe9794518c Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Wed, 20 Nov 2024 23:11:40 +0100 Subject: [PATCH 05/11] simplified bibliography, removed pac and version --- src/Poseidon/CLI/List.hs | 39 +++++++++--------- .../CLI/OptparseApplicativeParsers.hs | 16 +++++++- src/Poseidon/Package.hs | 40 ++++++++++--------- src/Poseidon/ServerClient.hs | 13 +----- 4 files changed, 57 insertions(+), 51 deletions(-) diff --git a/src/Poseidon/CLI/List.hs b/src/Poseidon/CLI/List.hs index 607a57487..f6f5c77ca 100644 --- a/src/Poseidon/CLI/List.hs +++ b/src/Poseidon/CLI/List.hs @@ -5,22 +5,23 @@ module Poseidon.CLI.List (runList, ListOptions(..), ListEntity(..), RepoLocation import Poseidon.EntityTypes (HasNameAndVersion (..)) import Poseidon.Package (PackageReadOptions (..), defaultPackageReadOptions, - getAllGroupInfo, + getAllGroupInfo, getBibliographyInfo, getExtendedIndividualInfo, packagesToPackageInfos, - readPoseidonPackageCollection, getBibliographyInfo) -import Poseidon.ServerClient (AddColSpec (..), - ApiReturnData (..), + readPoseidonPackageCollection) +import Poseidon.ServerClient (AddColSpec (..), ApiReturnData (..), ArchiveEndpoint (..), + BibliographyInfo (..), ExtendedIndividualInfo (..), GroupInfo (..), PackageInfo (..), - processApiResponse, qDefault, BibliographyInfo (..)) + processApiResponse, qDefault) import Poseidon.Utils (PoseidonIO, logInfo, logWarning) import Control.Monad (forM_, when) import Control.Monad.IO.Class (liftIO) -import Data.List (intercalate, sortOn, nub) +import Data.List (intercalate, nub, sortOn) import Data.Maybe (catMaybes, fromMaybe) +import qualified Data.Text as T import Data.Version (Version, showVersion) import Text.Layout.Table (asciiRoundS, column, def, expandUntil, @@ -141,15 +142,15 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do apiReturn <- processApiResponse (remoteURL ++ "/bibliography" ++ qDefault archive ++ addJannoColFlag) False case apiReturn of ApiReturnBibInfo bibInfo -> return bibInfo - _ -> error "should not happen" + _ -> error "should not happen" RepoLocal baseDirs -> do pacCollection <- readPoseidonPackageCollection pacReadOpts baseDirs getBibliographyInfo pacCollection addColSpec - + let addBibFieldNames = case addColSpec of AddColAll -> nub . concatMap (map fst . bibInfoAddCols) $ bibInfos AddColList names -> names - + -- warning in case the additional Columns do not exist in the entire janno dataset, -- we only output this warning if the columns were requested explicitly. Not if -- all columns were requested. We consider such an "all" request to mean "all columns that are present". @@ -164,22 +165,19 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do when (null nonEmptyEntries) . logWarning $ "Bibliography field " ++ bibFieldKey ++ "is not present in any bibliography entry" _ -> return () - + let tableH = ["BibKey", "Title", "Author", "Year", "Journal", "Doi", - "Package", "PackageVersion", "Is Latest", "Nr of samples"] ++ addBibFieldNames + "Nr of samples"] ++ addBibFieldNames tableB = do bibInfo <- bibInfos - True <- return (not onlyLatest || bibInfoIsLatest bibInfo) let addBibFieldColumns = do bibFieldName <- addBibFieldNames case bibFieldName `lookup` bibInfoAddCols bibInfo of Just (Just v) -> return v - _ -> return "" - return $ [bibInfoKey bibInfo, fromMaybe "" $ bibInfoTitle bibInfo, fromMaybe "" $ bibInfoAuthor bibInfo, - fromMaybe "" $ bibInfoYear bibInfo, fromMaybe "" $ bibInfoJournal bibInfo, - fromMaybe "" $ bibInfoDoi bibInfo, getPacName bibInfo, - showMaybeVersion (getPacVersion bibInfo), show (bibInfoIsLatest bibInfo), - show (bibInfoNrSamples bibInfo)] ++ + _ -> return "" + return $ [bibInfoKey bibInfo, curateBibField $ bibInfoTitle bibInfo, curateBibField $ bibInfoAuthor bibInfo, + curateBibField $ bibInfoYear bibInfo, curateBibField $ bibInfoJournal bibInfo, + curateBibField $ bibInfoDoi bibInfo, show (bibInfoNrSamples bibInfo)] ++ addBibFieldColumns return (tableH, tableB) @@ -193,3 +191,8 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do showMaybe = fromMaybe "n/a" showMaybeVersion :: Maybe Version -> String showMaybeVersion = maybe "n/a" showVersion + + -- this function is necessary, as BibTeX sometimes has arbitrary line breaks within fields, + -- which we need to get rid of to avoid down-stream problems + curateBibField :: Maybe String -> String + curateBibField = T.unpack . T.intercalate " " . map T.strip . T.lines . T.pack . fromMaybe "" diff --git a/src/Poseidon/CLI/OptparseApplicativeParsers.hs b/src/Poseidon/CLI/OptparseApplicativeParsers.hs index 6434105f6..700e81157 100644 --- a/src/Poseidon/CLI/OptparseApplicativeParsers.hs +++ b/src/Poseidon/CLI/OptparseApplicativeParsers.hs @@ -613,7 +613,10 @@ parseMaybeSnpFile = OP.option (Just <$> OP.str) ( OP.value Nothing) parseListEntity :: OP.Parser ListEntity -parseListEntity = parseListPackages <|> parseListGroups <|> (parseListIndividualsDummy *> parseListIndividualsExtraCols) +parseListEntity = parseListPackages <|> + parseListGroups <|> + (parseListIndividualsDummy *> parseListIndividualsExtraCols) <|> + (parseListBibliographyDummy *> parseListBibliographyExtraFields) where parseListPackages = OP.flag' ListPackages ( OP.long "packages" <> @@ -632,7 +635,16 @@ parseListEntity = parseListPackages <|> parseListGroups <|> (parseListIndividual OP.long "jannoColumn" <> OP.metavar "COLNAME" <> OP.help "List additional fields from the janno files, using the .janno column heading name, such as \ - \\"Country\", \"Site\", \"Date_C14_Uncal_BP\", etc..") + \\"Country\", \"Site\", \"Date_C14_Uncal_BP\", etc... Can be given multiple times") + parseListBibliographyDummy = OP.flag' () ( + OP.long "bibliography" <> OP.help "output bibliography information for packages") + parseListBibliographyExtraFields = ListBibliography <$> + (parseAllBibFields <|> (AddColList <$> OP.many parseExtraBibFields)) + parseAllBibFields = OP.flag' AddColAll (OP.long "fullBib" <> OP.help "output all bibliography fields found in any bibliography item") + parseExtraBibFields = OP.strOption ( + OP.short 'b' <> OP.long "bibField" <> OP.metavar "BIB-FIELD" <> + OP.help "List information from the given bibliography field, for example \"abstract\" or \"publisher\". Can \ + \be given multiple times.") parseRawOutput :: OP.Parser Bool parseRawOutput = OP.switch ( diff --git a/src/Poseidon/Package.hs b/src/Poseidon/Package.hs index 790e501f2..94c2dda06 100644 --- a/src/Poseidon/Package.hs +++ b/src/Poseidon/Package.hs @@ -865,24 +865,26 @@ filterToRelevantPackages entities packages = do return $ filter (\p -> makePacNameAndVersion p `elem` relevantPacs) packages getBibliographyInfo :: (MonadThrow m) => [PoseidonPackage] -> AddColSpec -> m [BibliographyInfo] -getBibliographyInfo allPackages addColSpec = sequence $ do - pac <- allPackages -- loop over packages, concatenating inner loops - (BibEntry _ bibId bibFields) <- posPacBib pac --loop over bib-entries - let nrSamples = length $ do -- list monad over samples - jannoRow <- getJannoRowsFromPac pac - let bibKeys = case jPublication jannoRow of - Nothing -> [] - Just jannoPubList -> map (\(JannoPublication p) -> unpack p) $ getListColumn jannoPubList - True <- return $ bibId `elem` bibKeys - return () - isLatest <- isLatestInCollection allPackages pac - let addBibEntries = case addColSpec of - -- with "all" we include all existing additional bib-entries except for the canonical ones that we anyway look up. - AddColAll -> [(k, Just v) | (k, v) <- bibFields, k `notElem` ["title", "author", "year", "journal", "doi"]] - -- with a selecton of colNames we just query the bib-fields for those exact fields. - AddColList colNames -> [(colName, colName `lookup` bibFields) | colName <- colNames] - return . return $ BibliographyInfo (makePacNameAndVersion pac) isLatest nrSamples bibId ("title" `lookup` bibFields) - ("author" `lookup` bibFields) ("year" `lookup` bibFields) ("journal" `lookup` bibFields) - ("doi" `lookup` bibFields) addBibEntries +getBibliographyInfo allPackages addColSpec = do + allLatestPacs <- filterM (isLatestInCollection allPackages) allPackages + -- we use only latest packages for this particular feature, otherwise interpretability gets weird. + let allBibEntries = nub . sortOn bibEntryId . concatMap posPacBib $ allLatestPacs + let jointJanno = getJannoRows $ getJointJanno allLatestPacs + forM allBibEntries $ \(BibEntry _ bibId bibFields) -> do + let nrSamples = length $ do -- list monad over samples + jannoRow <- jointJanno + let bibKeys = case jPublication jannoRow of + Nothing -> [] + Just jannoPubList -> map (\(JannoPublication p) -> unpack p) $ getListColumn jannoPubList + True <- return $ bibId `elem` bibKeys + return () + let addBibEntries = case addColSpec of + -- with "all" we include all existing additional bib-entries except for the canonical ones that we anyway look up. + AddColAll -> [(k, Just v) | (k, v) <- bibFields, k `notElem` ["title", "author", "year", "journal", "doi"]] + -- with a selecton of colNames we just query the bib-fields for those exact fields. + AddColList colNames -> [(colName, colName `lookup` bibFields) | colName <- colNames] + return $ BibliographyInfo nrSamples bibId ("title" `lookup` bibFields) + ("author" `lookup` bibFields) ("year" `lookup` bibFields) ("journal" `lookup` bibFields) + ("doi" `lookup` bibFields) addBibEntries diff --git a/src/Poseidon/ServerClient.hs b/src/Poseidon/ServerClient.hs index 0129493ed..74e70ea9e 100644 --- a/src/Poseidon/ServerClient.hs +++ b/src/Poseidon/ServerClient.hs @@ -236,8 +236,6 @@ extIndInfo2IndInfoCollection extIndInfos = data AddColSpec = AddColList [String] | AddColAll data BibliographyInfo = BibliographyInfo { - bibInfoPac :: PacNameAndVersion, - bibInfoIsLatest :: Bool, bibInfoNrSamples :: Int, bibInfoKey :: String, bibInfoTitle :: Maybe String, @@ -248,15 +246,8 @@ data BibliographyInfo = BibliographyInfo { bibInfoAddCols :: [(String, Maybe String)] } deriving (Eq) -instance HasNameAndVersion BibliographyInfo where - getPacName = getPacName . bibInfoPac - getPacVersion = getPacVersion . bibInfoPac - instance ToJSON BibliographyInfo where toJSON e = removeNulls $ object [ - "packageTitle" .= (getPacName . bibInfoPac $ e), - "packageVersion" .= (getPacVersion . bibInfoPac $ e), - "isLatest" .= bibInfoIsLatest e, "nrSamples" .= bibInfoNrSamples e, "bibKey" .= bibInfoKey e, "bibTitle" .= bibInfoTitle e, @@ -268,9 +259,7 @@ instance ToJSON BibliographyInfo where instance FromJSON BibliographyInfo where parseJSON = withObject "BibliographyInfo" $ \v -> BibliographyInfo - <$> (PacNameAndVersion <$> (v .: "packageTitle") <*> (v .:? "packageVersion")) - <*> v .: "isLatest" - <*> v .: "nrSamples" + <$> v .: "nrSamples" <*> v .: "bibKey" <*> v .:? "bibTitle" <*> v .:? "bibAuthor" From 7b61f6f70b5ffb39cf84c5bd3dac1b0160afabf0 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Wed, 20 Nov 2024 23:11:53 +0100 Subject: [PATCH 06/11] added new golden test --- test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt | 1 + test/PoseidonGoldenTests/GoldenTestData/list/list7 | 7 +++++++ test/PoseidonGoldenTests/GoldenTestsRunCommands.hs | 11 +++++++++++ 3 files changed, 19 insertions(+) create mode 100644 test/PoseidonGoldenTests/GoldenTestData/list/list7 diff --git a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt index 923fd0b61..bad7c07a3 100644 --- a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt +++ b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt @@ -26,6 +26,7 @@ b18847f5498ae55882689b75916fdf64 list list/list2 1c1f24de305405ece44393d378c0e15a list list/list4 bc636b9c03ea9359acd254a9911e5af3 list list/list5 ad5590b0ad65e64d6b2c8d874571c9f8 list list/list6 +ad23d70ac1effd500440eb5034087a10 list list/list7 b197fb8dd883c7469a4791e4a677f1c0 summarise summarise/summarise1 d9e4b3f15d4e129a365d2064198d95b6 summarise summarise/summarise2 a1186fdad9ed555dff4dd61dc9838645 survey survey/survey1 diff --git a/test/PoseidonGoldenTests/GoldenTestData/list/list7 b/test/PoseidonGoldenTests/GoldenTestData/list/list7 new file mode 100644 index 000000000..4baa013e4 --- /dev/null +++ b/test/PoseidonGoldenTests/GoldenTestData/list/list7 @@ -0,0 +1,7 @@ +.---------------.-----------.--------.------.---------.-----.---------------. +| BibKey | Title | Author | Year | Journal | Doi | Nr of samples | +:===============:===========:========:======:=========:=====:===============: +| Schiffels2016 | Test | | | | | 10 | +| TestBook1 | TestBook | | | | | 4 | +| TestPaper1 | TestPaper | | | | | 4 | +'---------------'-----------'--------'------'---------'-----'---------------' diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index ec86d05c8..24b77539a 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -358,26 +358,37 @@ testPipelineList testDir checkFilePath = do , _listOnlyLatest = False } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts1) "list" 1 + let listOpts2 = listOpts1 { _listListEntity = ListGroups } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts2) "list" 2 + let listOpts3 = listOpts1 { _listListEntity = ListIndividuals (AddColList ["Country", "Nr_SNPs"]) } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts3) "list" 3 + let listOpts4 = listOpts3 { _listRawOutput = True } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts4) "list" 4 + let listOpts5 = listOpts1 { _listOnlyLatest = True } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts5) "list" 5 + let listOpts6 = listOpts1 { _listListEntity = ListIndividuals AddColAll } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts6) "list" 6 + + let listOpts7 = listOpts1 { + _listListEntity = ListBibliography AddColAll + } + runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts7) "list" 7 + testPipelineSummarise :: FilePath -> FilePath -> IO () testPipelineSummarise testDir checkFilePath = do From 2996e6d4f62a9f77773b5fa7923bc48523f5b1b6 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Wed, 20 Nov 2024 23:12:09 +0100 Subject: [PATCH 07/11] stylish-haskell --- src/Poseidon/CLI/List.hs | 2 +- src/Poseidon/CLI/Serve.hs | 6 +++--- test/PoseidonGoldenTests/GoldenTestsRunCommands.hs | 12 ++++++------ 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Poseidon/CLI/List.hs b/src/Poseidon/CLI/List.hs index f6f5c77ca..fc3f18bae 100644 --- a/src/Poseidon/CLI/List.hs +++ b/src/Poseidon/CLI/List.hs @@ -191,7 +191,7 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do showMaybe = fromMaybe "n/a" showMaybeVersion :: Maybe Version -> String showMaybeVersion = maybe "n/a" showVersion - + -- this function is necessary, as BibTeX sometimes has arbitrary line breaks within fields, -- which we need to get rid of to avoid down-stream problems curateBibField :: Maybe String -> String diff --git a/src/Poseidon/CLI/Serve.hs b/src/Poseidon/CLI/Serve.hs index 818d8a608..572c37790 100644 --- a/src/Poseidon/CLI/Serve.hs +++ b/src/Poseidon/CLI/Serve.hs @@ -12,10 +12,10 @@ import Poseidon.Package (PackageReadOptions (..), PoseidonPackage (..), defaultPackageReadOptions, getAllGroupInfo, + getBibliographyInfo, getExtendedIndividualInfo, packagesToPackageInfos, - readPoseidonPackageCollection, - getBibliographyInfo) + readPoseidonPackageCollection) import Poseidon.PoseidonVersion (minimalRequiredClientVersion) import Poseidon.ServerClient (AddColSpec (..), ApiReturnData (..), @@ -131,7 +131,7 @@ runServer (ServeOptions archBaseDirs maybeZipPath port ignoreChecksums certFiles Nothing -> getExtendedIndividualInfo pacs (AddColList []) let retData = ApiReturnExtIndividualInfo indInfo return $ ServerApiReturnType [] (Just retData) - + get "/bibliography" . conditionOnClientVersion $ do logRequest logA pacs <- getItemFromArchiveStore archiveStore diff --git a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs index 24b77539a..c5da80ed2 100644 --- a/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs +++ b/test/PoseidonGoldenTests/GoldenTestsRunCommands.hs @@ -358,32 +358,32 @@ testPipelineList testDir checkFilePath = do , _listOnlyLatest = False } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts1) "list" 1 - + let listOpts2 = listOpts1 { _listListEntity = ListGroups } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts2) "list" 2 - + let listOpts3 = listOpts1 { _listListEntity = ListIndividuals (AddColList ["Country", "Nr_SNPs"]) } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts3) "list" 3 - + let listOpts4 = listOpts3 { _listRawOutput = True } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts4) "list" 4 - + let listOpts5 = listOpts1 { _listOnlyLatest = True } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts5) "list" 5 - + let listOpts6 = listOpts1 { _listListEntity = ListIndividuals AddColAll } runAndChecksumStdOut checkFilePath testDir (testLog $ runList listOpts6) "list" 6 - + let listOpts7 = listOpts1 { _listListEntity = ListBibliography AddColAll } From 597fa3136a7963f63ae2ba647c3d6adf618f2f5f Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Wed, 20 Nov 2024 23:15:21 +0100 Subject: [PATCH 08/11] bumped version, added Changelog --- CHANGELOG.md | 3 +++ poseidon-hs.cabal | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 856500f7c..8e1a57061 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +- V 1.5.9.0: + - Added a feature to list bibliography information via `trident list --bibliography`. + - Added a new Server API `/bibliography` to serve bibliography information via HTTP. - V 1.5.7.0: - Added support for VCF files (Variant Call Format) in Janno-packages. - restructured test package structure, affecting some of the unit- and golden tests. diff --git a/poseidon-hs.cabal b/poseidon-hs.cabal index d7e0d08b8..8959b3e2b 100644 --- a/poseidon-hs.cabal +++ b/poseidon-hs.cabal @@ -1,5 +1,5 @@ name: poseidon-hs -version: 1.5.7.0 +version: 1.5.9.0 synopsis: A package with tools for working with Poseidon genotype data description: The tools in this package read and analyse Poseidon-formatted genotype databases, a modular system for storing genotype data from thousands of individuals. license: MIT From 5ef48a1a8fac1d8eea6977e47092cc497b6895df Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Thu, 9 Jan 2025 13:41:21 +0100 Subject: [PATCH 09/11] made table smaller, implemented basic author rendering --- poseidon-hs.cabal | 4 ++-- src/Poseidon/BibFile.hs | 30 +++++++++++++++++++++++++++--- src/Poseidon/CLI/List.hs | 8 +++++--- src/Poseidon/Utils.hs | 6 +++--- test/Poseidon/BibFileSpec.hs | 21 ++++++++++++++++++++- 5 files changed, 57 insertions(+), 12 deletions(-) diff --git a/poseidon-hs.cabal b/poseidon-hs.cabal index 8859b507d..033bba538 100644 --- a/poseidon-hs.cabal +++ b/poseidon-hs.cabal @@ -28,11 +28,11 @@ library build-depends: base >= 4.7 && < 5, sequence-formats>=1.6.1, text, time, pipes-safe, exceptions, pipes, bytestring, filepath, yaml, aeson, directory, parsec, vector, pipes-ordered-zip, table-layout<1.0.0.0, mtl, split, warp, warp-tls, wai-cors, - -- scotty is set to < 0.20.0, because the current stackage resolver 21.17 does not have the latest version, but cabal uses it in the release action, if this constraint is not set scotty < 0.20.0, cassava, pureMD5, wai, githash, http-conduit, conduit, http-types, zip-archive, unordered-containers, network-uri, optparse-applicative, co-log, regex-tdfa, - scientific, country, generics-sop, containers, process, deepseq, template-haskell + scientific, country, generics-sop, containers, process, deepseq, template-haskell, + MissingH default-language: Haskell2010 executable trident diff --git a/src/Poseidon/BibFile.hs b/src/Poseidon/BibFile.hs index 3310fbfa4..f38915fb4 100644 --- a/src/Poseidon/BibFile.hs +++ b/src/Poseidon/BibFile.hs @@ -1,11 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} -module Poseidon.BibFile (dummyBibEntry, readBibTeXFile, writeBibTeXFile, BibTeX, BibEntry(..)) where +module Poseidon.BibFile (dummyBibEntry, readBibTeXFile, writeBibTeXFile, BibTeX, BibEntry(..), parseAuthors, authorAbbrvString) where import Poseidon.Utils (PoseidonException (..), showParsecErr) import Control.Exception (throwIO) -import Control.Monad (forM_, liftM2, liftM3) +import Control.Monad (forM, forM_, liftM2, + liftM3) +import Control.Monad.Catch (MonadThrow, throwM) +import Data.List (intercalate) +import Data.List.Split (splitOn) +import Data.String.Utils (strip) import System.IO (IOMode (..), hPutStrLn, withFile) import Text.Parsec (between, char, many, many1, @@ -53,7 +58,7 @@ readBibTeXFile :: FilePath -> IO BibTeX readBibTeXFile bibPath = do res <- parseFromFile bibFileParser bibPath case res of - Left err -> throwIO $ PoseidonBibTeXException bibPath $ showParsecErr err + Left err -> throwIO . PoseidonBibTeXException $ "In file " ++ bibPath ++ ": " ++ showParsecErr err Right res_ -> return res_ {- @@ -143,3 +148,22 @@ texBlock closeChar = comma :: CharParser st String comma = T.comma lexer +parseAuthors :: (MonadThrow m) => String -> m [(String, String)] -- parses a string of authors to a list of first names and last names +parseAuthors authorString = forM (splitOn " and " (intercalate " " . map strip . lines $ authorString)) $ \singleAuthorStr -> do + case splitOn ", " singleAuthorStr of + [lastName, firstName] -> return (firstName, lastName) + [firstName] -> return (firstName, "") -- in some cultures there are single first names, e.g. "Nini" + _ -> throwM . PoseidonBibTeXException $ "cannot parse bib-author " ++ singleAuthorStr + +authorAbbrvString :: [(String, String)] -> String +authorAbbrvString [] = "" +authorAbbrvString [firstAuthor] = renderAuthor True firstAuthor +authorAbbrvString [firstAuthor, secondAuthor] = renderAuthor False firstAuthor ++ " and " ++ renderAuthor False secondAuthor +authorAbbrvString (firstAuthor : _) = renderAuthor False firstAuthor ++ " et al." + +-- first argument is whether to render an author in full, or abbreviated. +renderAuthor :: Bool -> (String, String) -> String +renderAuthor True (first, "") = first -- there are edge cases where only first names exist, like in Consortia +renderAuthor True (first, family) = first ++ " " ++ family +renderAuthor False (first, "") = first +renderAuthor False (first, family) = [head first] ++ " " ++ family diff --git a/src/Poseidon/CLI/List.hs b/src/Poseidon/CLI/List.hs index fc3f18bae..853c18b29 100644 --- a/src/Poseidon/CLI/List.hs +++ b/src/Poseidon/CLI/List.hs @@ -2,6 +2,7 @@ module Poseidon.CLI.List (runList, ListOptions(..), ListEntity(..), RepoLocationSpec(..)) where +import Poseidon.BibFile (authorAbbrvString, parseAuthors) import Poseidon.EntityTypes (HasNameAndVersion (..)) import Poseidon.Package (PackageReadOptions (..), defaultPackageReadOptions, @@ -166,7 +167,7 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do "Bibliography field " ++ bibFieldKey ++ "is not present in any bibliography entry" _ -> return () - let tableH = ["BibKey", "Title", "Author", "Year", "Journal", "Doi", + let tableH = ["BibKey", "Title", "Author", "Year", "DOI", "Nr of samples"] ++ addBibFieldNames tableB = do bibInfo <- bibInfos @@ -175,8 +176,9 @@ runList (ListOptions repoLocation listEntity rawOutput onlyLatest) = do case bibFieldName `lookup` bibInfoAddCols bibInfo of Just (Just v) -> return v _ -> return "" - return $ [bibInfoKey bibInfo, curateBibField $ bibInfoTitle bibInfo, curateBibField $ bibInfoAuthor bibInfo, - curateBibField $ bibInfoYear bibInfo, curateBibField $ bibInfoJournal bibInfo, + authors <- parseAuthors . curateBibField . bibInfoAuthor $ bibInfo + return $ [bibInfoKey bibInfo, curateBibField $ bibInfoTitle bibInfo, authorAbbrvString authors, + curateBibField $ bibInfoYear bibInfo, curateBibField $ bibInfoDoi bibInfo, show (bibInfoNrSamples bibInfo)] ++ addBibFieldColumns return (tableH, tableB) diff --git a/src/Poseidon/Utils.hs b/src/Poseidon/Utils.hs index 5eea5340f..514060b0c 100644 --- a/src/Poseidon/Utils.hs +++ b/src/Poseidon/Utils.hs @@ -178,7 +178,7 @@ data PoseidonException = | PoseidonFileExistenceException FilePath -- ^ An exception to represent missing files | PoseidonFileChecksumException FilePath -- ^ An exception to represent failed checksum tests | PoseidonFStatsFormatException String -- ^ An exception type to represent FStat specification errors - | PoseidonBibTeXException FilePath String -- ^ An exception to represent errors when trying to parse the .bib file + | PoseidonBibTeXException String -- ^ An exception to represent errors when trying to parse the .bib file | PoseidonPoseidonEntityParsingException P.ParseError -- ^ An exception to indicate failed entity parsing | PoseidonForgeEntitiesException String -- ^ An exception to indicate issues in the forge selection | PoseidonEmptyForgeException -- ^ An exception to throw if there is nothing to be forged @@ -234,8 +234,8 @@ renderPoseidonException (PoseidonFileChecksumException f) = "File checksum test failed: " ++ f renderPoseidonException (PoseidonFStatsFormatException s) = "Fstat specification error: " ++ s -renderPoseidonException (PoseidonBibTeXException f s) = - "BibTex problem in file " ++ f ++ ": " ++ s +renderPoseidonException (PoseidonBibTeXException s) = + "BibTex-parsing problem: " ++ s renderPoseidonException (PoseidonPoseidonEntityParsingException e) = "Error when parsing the forge selection (either -f or --forgeFile): " ++ showParsecErr e renderPoseidonException (PoseidonForgeEntitiesException s) = diff --git a/test/Poseidon/BibFileSpec.hs b/test/Poseidon/BibFileSpec.hs index 47c631c91..1e4943365 100644 --- a/test/Poseidon/BibFileSpec.hs +++ b/test/Poseidon/BibFileSpec.hs @@ -1,13 +1,15 @@ module Poseidon.BibFileSpec (spec) where import Poseidon.BibFile (BibEntry (..), readBibTeXFile, - writeBibTeXFile) + writeBibTeXFile, parseAuthors, authorAbbrvString) import Test.Hspec spec :: Spec spec = do testBibReadWriteReadCycle + testParseAuthors + testAuthorAbbrvString testBibReadWriteReadCycle :: Spec testBibReadWriteReadCycle = describe @@ -24,3 +26,20 @@ testBibReadWriteReadCycle = describe map bibEntryId testReferences1 `shouldMatchList` ["A1971", "B2014", "P2020"] map bibEntryId testReferences1 `shouldMatchList` map bibEntryId testReferences2 map bibEntryFields testReferences1 `shouldMatchList` map bibEntryFields testReferences2 + +testParseAuthors :: Spec +testParseAuthors = describe "Poseidon.BibFile.parseAuthors" $ do + let authorStr = "Lazaridis, Iosif and Patterson, Nick and Mittnik, Alissa and Lamnidis, Thiseas Christos" + it "should parse authors correctly" $ + parseAuthors authorStr `shouldReturn` [("Iosif", "Lazaridis"), ("Nick", "Patterson"), ("Alissa", "Mittnik"), ("Thiseas Christos", "Lamnidis")] + +testAuthorAbbrvString :: Spec +testAuthorAbbrvString = describe "Poseidon.BibFile.authorAbbrvString" $ do + it "should correctly render single author" $ + authorAbbrvString [("Susie", "Haak")] `shouldBe` "Susie Haak" + it "should correctly render two authors" $ + authorAbbrvString [("Susie", "Haak"), ("Jack", "Ryan")] `shouldBe` "S Haak and J Ryan" + it "should correctly render more than two authors" $ + authorAbbrvString [("Susie", "Haak"), ("Jack", "Ryan"), ("Sabrina", "Fisher")] `shouldBe` "S Haak et al." + + \ No newline at end of file From cfc18bb161b408e22de1ed3ab489029bb38b830d Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Thu, 9 Jan 2025 14:10:50 +0100 Subject: [PATCH 10/11] stylish-haskell --- src/Poseidon/BibFile.hs | 6 +++--- test/Poseidon/BibFileSpec.hs | 9 +++++---- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Poseidon/BibFile.hs b/src/Poseidon/BibFile.hs index f38915fb4..a20c8e070 100644 --- a/src/Poseidon/BibFile.hs +++ b/src/Poseidon/BibFile.hs @@ -163,7 +163,7 @@ authorAbbrvString (firstAuthor : _) = renderAuthor False firstAuthor + -- first argument is whether to render an author in full, or abbreviated. renderAuthor :: Bool -> (String, String) -> String -renderAuthor True (first, "") = first -- there are edge cases where only first names exist, like in Consortia -renderAuthor True (first, family) = first ++ " " ++ family -renderAuthor False (first, "") = first +renderAuthor True (first, "") = first -- there are edge cases where only first names exist, like in Consortia +renderAuthor True (first, family) = first ++ " " ++ family +renderAuthor False (first, "") = first renderAuthor False (first, family) = [head first] ++ " " ++ family diff --git a/test/Poseidon/BibFileSpec.hs b/test/Poseidon/BibFileSpec.hs index 1e4943365..767132d78 100644 --- a/test/Poseidon/BibFileSpec.hs +++ b/test/Poseidon/BibFileSpec.hs @@ -1,7 +1,8 @@ module Poseidon.BibFileSpec (spec) where -import Poseidon.BibFile (BibEntry (..), readBibTeXFile, - writeBibTeXFile, parseAuthors, authorAbbrvString) +import Poseidon.BibFile (BibEntry (..), authorAbbrvString, + parseAuthors, readBibTeXFile, + writeBibTeXFile) import Test.Hspec @@ -41,5 +42,5 @@ testAuthorAbbrvString = describe "Poseidon.BibFile.authorAbbrvString" $ do authorAbbrvString [("Susie", "Haak"), ("Jack", "Ryan")] `shouldBe` "S Haak and J Ryan" it "should correctly render more than two authors" $ authorAbbrvString [("Susie", "Haak"), ("Jack", "Ryan"), ("Sabrina", "Fisher")] `shouldBe` "S Haak et al." - - \ No newline at end of file + + From 2ee8f6941731c8668b531ae0cf334800f3856399 Mon Sep 17 00:00:00 2001 From: Stephan Schiffels Date: Fri, 10 Jan 2025 09:50:53 +0100 Subject: [PATCH 11/11] updated golde test with bib-listing --- .../PoseidonGoldenTests/GoldenTestCheckSumFile.txt | 2 +- .../GoldenTestData/chronicle/chronicle2.yml | 14 +++++++------- test/PoseidonGoldenTests/GoldenTestData/list/list7 | 14 +++++++------- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt index 52d5b047e..a2f4e5a07 100644 --- a/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt +++ b/test/PoseidonGoldenTests/GoldenTestCheckSumFile.txt @@ -26,7 +26,7 @@ b18847f5498ae55882689b75916fdf64 list list/list2 1c1f24de305405ece44393d378c0e15a list list/list4 bc636b9c03ea9359acd254a9911e5af3 list list/list5 ad5590b0ad65e64d6b2c8d874571c9f8 list list/list6 -ad23d70ac1effd500440eb5034087a10 list list/list7 +35689d85d4ac5da9a4189b728403f16b list list/list7 b197fb8dd883c7469a4791e4a677f1c0 summarise summarise/summarise1 d9e4b3f15d4e129a365d2064198d95b6 summarise summarise/summarise2 a1186fdad9ed555dff4dd61dc9838645 survey survey/survey1 diff --git a/test/PoseidonGoldenTests/GoldenTestData/chronicle/chronicle2.yml b/test/PoseidonGoldenTests/GoldenTestData/chronicle/chronicle2.yml index eca107057..23062aba5 100644 --- a/test/PoseidonGoldenTests/GoldenTestData/chronicle/chronicle2.yml +++ b/test/PoseidonGoldenTests/GoldenTestData/chronicle/chronicle2.yml @@ -1,29 +1,29 @@ title: Chronicle title description: Chronicle description chronicleVersion: 0.2.0 -lastModified: 2024-11-13 +lastModified: 2025-01-10 packages: - title: Lamnidis_2018 version: 1.0.0 - commit: c59bfb82fec3f2742cc0e10ceb2932ee06e56aa1 + commit: b32c9f515f21eb9b223bc6d2faa9ed863644cb4a path: Lamnidis_2018 - title: Lamnidis_2018 version: 1.0.1 - commit: c59bfb82fec3f2742cc0e10ceb2932ee06e56aa1 + commit: b32c9f515f21eb9b223bc6d2faa9ed863644cb4a path: Lamnidis_2018_newVersion - title: Schiffels version: 1.1.1 - commit: a32a46cf82b8895af72c8920be4ca4843cd5e7f7 + commit: 263210068adba1074521eca3a6be71cee8a2166c path: Schiffels - title: Schiffels_2016 version: 1.0.1 - commit: c59bfb82fec3f2742cc0e10ceb2932ee06e56aa1 + commit: b32c9f515f21eb9b223bc6d2faa9ed863644cb4a path: Schiffels_2016 - title: Schmid_2028 version: 1.0.0 - commit: c59bfb82fec3f2742cc0e10ceb2932ee06e56aa1 + commit: b32c9f515f21eb9b223bc6d2faa9ed863644cb4a path: Schmid_2028 - title: Wang_2020 version: 0.1.0 - commit: c59bfb82fec3f2742cc0e10ceb2932ee06e56aa1 + commit: b32c9f515f21eb9b223bc6d2faa9ed863644cb4a path: Wang_2020 diff --git a/test/PoseidonGoldenTests/GoldenTestData/list/list7 b/test/PoseidonGoldenTests/GoldenTestData/list/list7 index 4baa013e4..b3c556cf6 100644 --- a/test/PoseidonGoldenTests/GoldenTestData/list/list7 +++ b/test/PoseidonGoldenTests/GoldenTestData/list/list7 @@ -1,7 +1,7 @@ -.---------------.-----------.--------.------.---------.-----.---------------. -| BibKey | Title | Author | Year | Journal | Doi | Nr of samples | -:===============:===========:========:======:=========:=====:===============: -| Schiffels2016 | Test | | | | | 10 | -| TestBook1 | TestBook | | | | | 4 | -| TestPaper1 | TestPaper | | | | | 4 | -'---------------'-----------'--------'------'---------'-----'---------------' +.---------------.-----------.--------.------.-----.---------------. +| BibKey | Title | Author | Year | DOI | Nr of samples | +:===============:===========:========:======:=====:===============: +| Schiffels2016 | Test | | | | 10 | +| TestBook1 | TestBook | | | | 4 | +| TestPaper1 | TestPaper | | | | 4 | +'---------------'-----------'--------'------'-----'---------------'