Bibliography API and listing functionality

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.4:
     - Fixed a bug that broke the long-form genotype data input option (with `--genoFile + --snpFile + ...`).
 - V 1.5.7.3:

poseidon-hs.cabal

@@ -1,5 +1,5 @@
 name:                poseidon-hs
-version:             1.5.7.4
+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

src/Poseidon/CLI/List.hs

@@ -5,22 +5,23 @@
 import           Poseidon.EntityTypes   (HasNameAndVersion (..))
 import           Poseidon.Package       (PackageReadOptions (..),
                                          defaultPackageReadOptions,
-                                         getAllGroupInfo,
+                                         getAllGroupInfo, getBibliographyInfo,
                                          getExtendedIndividualInfo,
                                          packagesToPackageInfos,
                                          readPoseidonPackageCollection)
-import           Poseidon.ServerClient  (AddJannoColSpec (..),
-                                         ApiReturnData (..),
+import           Poseidon.ServerClient  (AddColSpec (..), ApiReturnData (..),
                                          ArchiveEndpoint (..),
+                                         BibliographyInfo (..),
                                          ExtendedIndividualInfo (..),
                                          GroupInfo (..), PackageInfo (..),
                                          processApiResponse, qDefault)
 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, 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,
@@ -39,7 +40,8 @@
 -- | 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 +97,9 @@
                 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 +116,7 @@
             -- 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 +131,56 @@
                               showMaybeVersion (getPacVersion i), show  isLatest] ++
                               map (fromMaybe "n/a" . snd) addColumnEntries
             return (tableH, tableB)
+        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",
+                          "Nr of samples"] ++ addBibFieldNames
+                tableB = do
+                    bibInfo <- bibInfos
+                    let addBibFieldColumns = do
+                            bibFieldName <- addBibFieldNames
+                            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,
+                              curateBibField $ bibInfoDoi bibInfo, show (bibInfoNrSamples bibInfo)] ++
+                              addBibFieldColumns
+            return (tableH, tableB)
+
     if rawOutput then
         liftIO $ putStrLn $ intercalate "\n" [intercalate "\t" row | row <- tableH:tableB]
     else do
@@ -139,3 +191,8 @@
     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 ""

src/Poseidon/CLI/OptparseApplicativeParsers.hs

@@ -21,7 +21,7 @@
                                              GenotypeDataSpec (..),
                                              GenotypeFileSpec (..),
                                              SNPSetSpec (..))
-import           Poseidon.ServerClient      (AddJannoColSpec (..),
+import           Poseidon.ServerClient      (AddColSpec (..),
                                              ArchiveEndpoint (..))
 import           Poseidon.Utils             (ErrorLength (..), LogMode (..),
                                              TestMode (..),
@@ -636,7 +636,10 @@
     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" <>
@@ -648,14 +651,23 @@
     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" <>
         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 (

src/Poseidon/CLI/Serve.hs

@@ -12,11 +12,12 @@
                                                PoseidonPackage (..),
                                                defaultPackageReadOptions,
                                                getAllGroupInfo,
+                                               getBibliographyInfo,
                                                getExtendedIndividualInfo,
                                                packagesToPackageInfos,
                                                readPoseidonPackageCollection)
 import           Poseidon.PoseidonVersion     (minimalRequiredClientVersion)
-import           Poseidon.ServerClient        (AddJannoColSpec (..),
+import           Poseidon.ServerClient        (AddColSpec (..),
                                                ApiReturnData (..),
                                                ServerApiReturnType (..))
 import           Poseidon.Utils               (LogA, PoseidonIO, envLogAction,
@@ -123,14 +124,27 @@
             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
+            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
         when (isJust maybeZipPath) . get "/zip_file/:package_name" $ do
             logRequest logA

src/Poseidon/Package.hs

@@ -26,11 +26,13 @@
     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 @@
                                              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.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 @@
     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,28 @@
     indInfoCollection <- getJointIndividualInfo packages
     relevantPacs <- determineRelevantPackages entities indInfoCollection
     return $ filter (\p -> makePacNameAndVersion p `elem` relevantPacs) packages
+
+getBibliographyInfo :: (MonadThrow m) => [PoseidonPackage] -> AddColSpec -> m [BibliographyInfo]
+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
+
+