Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

[EDNA-130] Add an optimized getter of filtered experiments #92

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Next Next commit
Add experiments summary getter
Problem: in order to construct dashboard selectors we use the
`/experiments` endpoint to get all experiments. It sends a lot of data
and works slowly, especially when we pass no filters.

Solution: add another endpoints that returns only names of relevant
projects, compounds and targets. It works much faster, returns less
data and still makes it possible to construct selectors.
In future we'll also add endpoints to query all project/compound/target
names without querying all data about them.
gromakovsky committed May 8, 2021

Verified

This commit was created on GitHub.com and signed with GitHub’s verified signature. The key has expired.
commit 42466731b24dcfbb127736ea733ebb9edcde9cf8
9 changes: 9 additions & 0 deletions backend/src/Edna/DB/Integration.hs
Original file line number Diff line number Diff line change
@@ -15,10 +15,12 @@ module Edna.DB.Integration
, runDeleteReturningList'
, runSelectReturningOne'
, runSelectReturningList'
, runSelectReturningSet
) where

import Universum

import qualified Data.Set as Set
import qualified Database.Beam.Postgres.Conduit as C

import Database.Beam.Backend.SQL.BeamExtensions (runInsertReturningList)
@@ -96,3 +98,10 @@ runSelectReturningOne' = runPg . runSelectReturningOne

runSelectReturningList' :: FromBackendRow Postgres a => SqlSelect Postgres a -> Edna [a]
runSelectReturningList' = runPg . runSelectReturningList

-- | Run @SELECT@ and convert its result into a set. Conversion happens in Haskell.
-- Note that all duplicates are silently removed and items are sorted.
runSelectReturningSet ::
(Ord a, FromBackendRow Postgres a) =>
SqlSelect Postgres a -> Edna (Set a)
runSelectReturningSet = fmap Set.fromList . runSelectReturningList'
71 changes: 69 additions & 2 deletions backend/src/Edna/Dashboard/DB/Query.hs
Original file line number Diff line number Diff line change
@@ -10,6 +10,9 @@ module Edna.Dashboard.DB.Query
, setIsSuspiciousSubExperiment
, deleteSubExperiment
, getExperiments
, getMatchedProjects
, getMatchedCompounds
, getMatchedTargets
, getDescriptionAndMetadata
, getFileNameAndBlob
, getSubExperiment
@@ -34,14 +37,16 @@ import Servant.Util.Combinators.Sorting.Backend (fieldSort)

import Edna.Analysis.FourPL (AnalysisResult, Params4PL(..))
import Edna.DB.Integration
(runDeleteReturningList', runSelectReturningList', runSelectReturningOne', runUpdate')
(runDeleteReturningList', runSelectReturningList', runSelectReturningOne', runSelectReturningSet,
runUpdate')
import Edna.DB.Schema (EdnaSchema(..), ednaSchema)
import Edna.DB.Util (groupAndPaginate, sortingSpecWithId)
import Edna.Dashboard.DB.Schema
import Edna.Dashboard.Web.Types (ExperimentResp(..), ExperimentSortingSpec)
import Edna.ExperimentReader.Types (FileMetadata)
import Edna.Library.DB.Schema
(CompoundRec, CompoundT(..), TargetRec, TargetT(..), TestMethodologyRec, TestMethodologyT(..))
(CompoundRec, CompoundT(..), ProjectT(..), TargetRec, TargetT(..), TestMethodologyRec,
TestMethodologyT(..))
import Edna.Orphans ()
import Edna.Setup (Edna)
import Edna.Upload.DB.Schema (ExperimentFileT(..))
@@ -200,6 +205,68 @@ getExperiments mProj mComp mTarget sorting pagination =
Nothing -> error $ "can't find primary sub-experiment: " <> pretty primary
Just (_, PgJSON analysisResult) -> p4plC <$> analysisResult

-- | Get names of all projects with experiments optionally filtered by
-- compound and target.
getMatchedProjects :: Maybe CompoundId -> Maybe TargetId -> Edna (Set Text)
getMatchedProjects mComp mTarget =
runSelectReturningSet $ select $ do
experiment <- all_ $ esExperiment ednaSchema
filterByTarget mTarget experiment
filterByCompound mComp experiment

experimentFile <- join_ (esExperimentFile ednaSchema) $ \ef ->
eExperimentFileId experiment ==. cast_ (efExperimentFileId ef) int

project <- join_ (esProject ednaSchema) $ \p ->
efProjectId experimentFile ==. cast_ (pProjectId p) int
return (pName project)

-- | Get names of all compounds from experiments optionally filtered by
-- project and target.
getMatchedCompounds :: Maybe ProjectId -> Maybe TargetId -> Edna (Set Text)
getMatchedCompounds mProj mTarget =
runSelectReturningSet $ select $ do
experiment <- all_ $ esExperiment ednaSchema
filterByProject mProj experiment
filterByTarget mTarget experiment

compound <- join_ (esCompound ednaSchema) $ \comp ->
cast_ (cCompoundId comp) int ==. eCompoundId experiment
return (cName compound)

-- | Get names of all targets from experiments optionally filtered by
-- project and compound.
getMatchedTargets :: Maybe ProjectId -> Maybe CompoundId -> Edna (Set Text)
getMatchedTargets mProj mComp =
runSelectReturningSet $ select $ do
experiment <- all_ $ esExperiment ednaSchema
filterByProject mProj experiment
filterByCompound mComp experiment

target <- join_ (esTarget ednaSchema) $ \tar ->
cast_ (tTargetId tar) int ==. eTargetId experiment
return (tName target)

filterByProject ::
Maybe ProjectId ->
ExperimentT (QExpr Postgres s) -> Q Postgres EdnaSchema s ()
filterByProject mProj experiment = whenJust mProj $ \(SqlId projId) -> do
experimentFile <- join_ (esExperimentFile ednaSchema) $ \ef ->
eExperimentFileId experiment ==. cast_ (efExperimentFileId ef) int
guard_ (efProjectId experimentFile ==. val_ projId)

filterByCompound ::
Maybe CompoundId ->
ExperimentT (QExpr Postgres s) -> Q Postgres EdnaSchema s ()
filterByCompound mComp experiment = whenJust mComp $ \(SqlId compId) ->
guard_ (eCompoundId experiment ==. val_ compId)

filterByTarget ::
Maybe TargetId ->
ExperimentT (QExpr Postgres s) -> Q Postgres EdnaSchema s ()
filterByTarget mTarget experiment = whenJust mTarget $ \(SqlId targetId) ->
guard_ (eTargetId experiment ==. val_ targetId)

-- | Get description and metadata of experiment data file storing experiment
-- with this ID.
getDescriptionAndMetadata ::
34 changes: 33 additions & 1 deletion backend/src/Edna/Dashboard/Service.hs
Original file line number Diff line number Diff line change
@@ -13,6 +13,8 @@ module Edna.Dashboard.Service
, newSubExperiment
, analyseNewSubExperiment
, getExperiments
, getExperimentsSummary
, getActiveProjectNames
, getExperimentMetadata
, getExperimentFile
, getSubExperiment
@@ -30,6 +32,7 @@ import Servant.API (NoContent(..))
import Servant.Util (PaginationSpec)

import qualified Edna.Dashboard.DB.Query as Q
import qualified Edna.Library.DB.Query as LQ
import qualified Edna.Upload.DB.Query as UQ

import Edna.Analysis.FourPL (AnalysisResult, analyse4PLOne)
@@ -38,7 +41,7 @@ import Edna.Dashboard.DB.Schema (MeasurementT(..), SubExperimentRec, SubExperime
import Edna.Dashboard.Error (DashboardError(..))
import Edna.Dashboard.Web.Types
(ExperimentFileBlob(..), ExperimentMetadata(..), ExperimentSortingSpec, ExperimentsResp(..),
MeasurementResp(..), NewSubExperimentReq(..), SubExperimentResp(..))
ExperimentsSummaryResp(..), MeasurementResp(..), NewSubExperimentReq(..), SubExperimentResp(..))
import Edna.ExperimentReader.Types (FileMetadata(..))
import Edna.Logging (logMessage)
import Edna.Setup (Edna)
@@ -141,6 +144,35 @@ getExperiments mProj mComp mTarget sorting pagination =
unwrapResult :: PgJSON AnalysisResult -> AnalysisResult
unwrapResult (PgJSON res) = res

-- | Get short data about all experiments using 3 optional filters: by project ID,
-- compound ID and target ID. See description of 'ExperimentsSummaryResp' for details.
getExperimentsSummary :: Maybe ProjectId -> Maybe CompoundId -> Maybe TargetId ->
Edna ExperimentsSummaryResp
getExperimentsSummary mProj mComp mTarget = do
-- Getting all projects in the system would be wrong because there can be
-- empty ones.
esrMatchedProjects <- Q.getMatchedProjects mComp mTarget
esrMatchedCompounds <-
getMatchedOrAll mProj mTarget Q.getMatchedCompounds LQ.getCompoundNames
esrMatchedTargets <-
getMatchedOrAll mProj mComp Q.getMatchedTargets LQ.getTargetNames
return ExperimentsSummaryResp {..}
where
-- If at least one filter is provided, we call @getMatched@.
-- Otherwise we call @getAll@ which gets all items in the system.
getMatchedOrAll ::
Maybe filter1 -> Maybe filter2 ->
(Maybe filter1 -> Maybe filter2 -> Edna res) ->
Edna res ->
Edna res
getMatchedOrAll filter1 filter2 getMatched getAll
| isNothing filter1 && isNothing filter2 = getAll
| otherwise = getMatched filter1 filter2

-- | Get names of all projects with at least one experiment.
getActiveProjectNames :: Edna (Set Text)
getActiveProjectNames = Q.getMatchedProjects Nothing Nothing

-- | Get all metadata about experiment data file containing experiment
-- with this ID. "All" metadata means metadata from the file itself
-- along with description provided by the user.
15 changes: 13 additions & 2 deletions backend/src/Edna/Dashboard/Web/API.hs
Original file line number Diff line number Diff line change
@@ -23,8 +23,8 @@ import Servant.Util (PaginationParams, SortingParamsOf)
import Edna.Analysis.FourPL (AnalysisResult)
import Edna.Dashboard.Service
(analyseNewSubExperiment, deleteSubExperiment, getExperimentFile, getExperimentMetadata,
getExperiments, getMeasurements, getSubExperiment, makePrimarySubExperiment, newSubExperiment,
setIsSuspiciousSubExperiment, setNameSubExperiment)
getExperiments, getExperimentsSummary, getMeasurements, getSubExperiment,
makePrimarySubExperiment, newSubExperiment, setIsSuspiciousSubExperiment, setNameSubExperiment)
import Edna.Dashboard.Web.Types
import Edna.Setup (Edna)
import Edna.Util (CompoundId, ExperimentId, IdType(..), ProjectId, SubExperimentId, TargetId)
@@ -96,6 +96,16 @@ data DashboardEndpoints route = DashboardEndpoints
:> PaginationParams
:> Get '[JSON] ExperimentsResp

, -- | Get summary of all experiments
deGetExperimentsSummary :: route
:- "experiments"
:> "summary"
:> Summary "Get summary of all experiments"
:> QueryParam "projectId" ProjectId
:> QueryParam "compoundId" CompoundId
:> QueryParam "targetId" TargetId
:> Get '[JSON] ExperimentsSummaryResp

, -- | Get experiment's metadata by ID
deGetExperimentMetadata :: route
:- "experiment"
@@ -140,6 +150,7 @@ dashboardEndpoints = genericServerT DashboardEndpoints
, deNewSubExp = newSubExperiment
, deAnalyseNewSubExp = fmap snd ... analyseNewSubExperiment
, deGetExperiments = getExperiments
, deGetExperimentsSummary = getExperimentsSummary
, deGetExperimentMetadata = getExperimentMetadata
, deGetExperimentFile = \i -> getExperimentFile i <&>
\(name, blob) -> addHeader ("attachment;filename=" <> name) blob
45 changes: 44 additions & 1 deletion backend/src/Edna/Dashboard/Web/Types.hs
Original file line number Diff line number Diff line change
@@ -9,6 +9,7 @@ module Edna.Dashboard.Web.Types
, ExperimentsResp (..)
, ExperimentResp (..)
, ExperimentSortingSpec
, ExperimentsSummaryResp (..)
, SubExperimentResp (..)
, MeasurementResp (..)
, ExperimentMetadata (..)
@@ -48,7 +49,7 @@ instance Buildable NewSubExperimentReq where
"new sub-experiment name: " +| nserName |+
", changes: " +| toList nserChanges |+ ""

-- | Experiment as response from the server.
-- | Experiments as response from the server.
newtype ExperimentsResp = ExperimentsResp
{ erExperiments :: [WithId 'ExperimentId ExperimentResp]
} deriving stock (Generic, Show)
@@ -115,6 +116,44 @@ type instance SortingParamTypesOf ExperimentResp =

type ExperimentSortingSpec = SortingSpec (SortingParamTypesOf ExperimentResp)

-- | Summary of experiments matching given search. We use it to show selectors.
data ExperimentsSummaryResp = ExperimentsSummaryResp
{ esrMatchedProjects :: Set Text
-- ^ If target and/or compound filter is specified, these are all projects
-- where specified target and/or compound is used.
-- Otherwise this list contains all projects.
, esrMatchedCompounds :: Set Text
-- ^ If target and/or project filter is specified, these are all compounds
-- used in specified project and/or with specified target.
-- Otherwise this list contains all compounds.
, esrMatchedTargets :: Set Text
-- ^ If compound and/or project filter is specified, these are all targets
-- used in specified project and/or with specified compound.
-- Otherwise this list contains all targets.
} deriving stock (Generic, Show, Eq)

instance Buildable ExperimentsSummaryResp where
build = genericF

-- | Temporary newtype we use to provide @instance Buildable (ForResponseLog Text)@.
-- Probably will disappear when we introduce @Name@ type.
newtype BuildableResponseLog a = BuildableResponseLog a

instance Buildable a => Buildable (ForResponseLog (BuildableResponseLog a)) where
build (ForResponseLog (BuildableResponseLog a)) = build a

instance Buildable (ForResponseLog ExperimentsSummaryResp) where
build (ForResponseLog (ExperimentsSummaryResp projects compounds targets)) =
"ExperimentsSummary:\n" <>
" matched projects:\n" <>
buildListForResponse (take 12) (wrap projects) <>
" matched compounds:\n" <>
buildListForResponse (take 12) (wrap compounds) <>
" matched targets:\n" <>
buildListForResponse (take 12) (wrap targets)
where
wrap = ForResponseLog . map BuildableResponseLog . toList

-- | SubExperiment as response from the server.
data SubExperimentResp = SubExperimentResp
{ serName :: Text
@@ -198,6 +237,7 @@ instance Buildable (ForResponseLog $
deriveJSON ednaAesonWebOptions ''NewSubExperimentReq
deriveToJSON ednaAesonWebOptions ''ExperimentsResp
deriveToJSON ednaAesonWebOptions ''ExperimentResp
deriveToJSON ednaAesonWebOptions ''ExperimentsSummaryResp
deriveToJSON ednaAesonWebOptions ''SubExperimentResp
deriveToJSON ednaAesonWebOptions ''MeasurementResp
deriveToJSON ednaAesonWebOptions ''ExperimentMetadata
@@ -208,6 +248,9 @@ instance ToSchema NewSubExperimentReq where
instance ToSchema ExperimentsResp where
declareNamedSchema = gDeclareNamedSchema

instance ToSchema ExperimentsSummaryResp where
declareNamedSchema = gDeclareNamedSchema

instance ToSchema ExperimentResp where
declareNamedSchema = gDeclareNamedSchema

16 changes: 14 additions & 2 deletions backend/src/Edna/Library/DB/Query.hs
Original file line number Diff line number Diff line change
@@ -9,8 +9,10 @@
module Edna.Library.DB.Query
( getTargetById
, getTargets
, getTargetNames
, getCompoundById
, getCompounds
, getCompoundNames
, editCompoundChemSoft
, editCompoundMde
, getMethodologyById
@@ -47,7 +49,7 @@ import Servant.Util.Combinators.Sorting.Backend (fieldSort)

import Edna.DB.Integration
(runDeleteReturningList', runInsert', runInsertReturningOne', runSelectReturningList',
runSelectReturningOne', runUpdate')
runSelectReturningOne', runSelectReturningSet, runUpdate')
import Edna.DB.Schema (EdnaSchema(..), ednaSchema)
import Edna.DB.Util (groupAndPaginate, sortingSpecWithId)
import Edna.Dashboard.DB.Schema (ExperimentT(..))
@@ -128,6 +130,11 @@ getTargetByName name = runSelectReturningOne' $ select $ do
guard_ (LDB.tName targets ==. val_ name)
pure targets

-- | Get names of all targets in the system.
getTargetNames :: Edna (Set Text)
getTargetNames = runSelectReturningSet $ select $
tName <$> all_ (esTarget ednaSchema)

-- | Insert target with given name and return its DB value. If target with this name
-- already exists do nothing and simply return it.
insertTarget :: Text -> Edna TargetRec
@@ -161,6 +168,11 @@ getCompounds sorting pagination = runSelectReturningList' $ select $
fieldSort @"additionDate" cAdditionDate .*.
HNil

-- | Get names of all compounds in the system.
getCompoundNames :: Edna (Set Text)
getCompoundNames = runSelectReturningSet $ select $
cName <$> all_ (esCompound ednaSchema)

-- | Edit ChemSoft link of a given compound
editCompoundChemSoft :: CompoundId -> Text -> Edna ()
editCompoundChemSoft (SqlId compoundId) link = runUpdate' $ update
@@ -339,7 +351,7 @@ projectsWithCompounds projectIdEither =
fieldSort @"lastUpdate" pLastUpdate .*.
HNil

-- | Insert project and return its DB value
-- | Insert project and return its DB value.
-- Fails if project with this name already exists
insertProject :: ProjectReq -> Edna ProjectRec
insertProject ProjectReq{..} = runInsertReturningOne' $
4 changes: 4 additions & 0 deletions backend/src/Edna/Library/Service.hs
Original file line number Diff line number Diff line change
@@ -21,6 +21,10 @@ module Edna.Library.Service
, getProjects
, addProject
, updateProject

-- * Re-export some queries as is
, Q.getTargetNames
, Q.getCompoundNames
) where

import Universum
62 changes: 57 additions & 5 deletions backend/test/Test/DashboardSpec.hs
Original file line number Diff line number Diff line change
@@ -26,15 +26,15 @@ import qualified Edna.Library.Service as Library
import Edna.Analysis.FourPL (Params4PL(..), analyse4PLOne)
import Edna.Dashboard.Error (DashboardError(..))
import Edna.Dashboard.Service
(analyseNewSubExperiment, deleteSubExperiment, getExperimentFile, getExperimentMetadata,
getExperiments, getMeasurements, getSubExperiment, makePrimarySubExperiment, newSubExperiment,
setIsSuspiciousSubExperiment, setNameSubExperiment)
(analyseNewSubExperiment, deleteSubExperiment, getActiveProjectNames, getExperimentFile,
getExperimentMetadata, getExperiments, getExperimentsSummary, getMeasurements, getSubExperiment,
makePrimarySubExperiment, newSubExperiment, setIsSuspiciousSubExperiment, setNameSubExperiment)
import Edna.Dashboard.Web.Types
(ExperimentFileBlob(..), ExperimentMetadata(..), ExperimentResp(..), ExperimentsResp(..),
MeasurementResp(..), NewSubExperimentReq(..), SubExperimentResp(..))
ExperimentsSummaryResp(..), MeasurementResp(..), NewSubExperimentReq(..), SubExperimentResp(..))
import Edna.ExperimentReader.Types
(FileMetadata(unFileMetadata), Measurement(..), measurementToPairMaybe)
import Edna.Library.Web.Types (MethodologyReq(..))
import Edna.Library.Web.Types (MethodologyReq(..), ProjectReq(..))
import Edna.Setup (EdnaContext)
import Edna.Util (ExperimentId, IdType(..), SqlId(..), SubExperimentId)
import Edna.Web.Types (WithId(..))
@@ -123,6 +123,7 @@ spec = withContext $ do
where
addSampleData = do
addSampleProjects
void $ Library.addProject (ProjectReq "unused project" Nothing)
addSampleMethodologies
toDeleteId <- wiId <$> Library.addMethodology (MethodologyReq "toDelete" Nothing Nothing)
uploadFileTest (SqlId 1) (SqlId 1) sampleFile
@@ -224,6 +225,54 @@ gettersSpec = do
descByTarget `shouldBe`
paginateAndGetIds (sortWith getTargetName allExperiments)

describe "getExperimentsSummary" $ do
let
projectId = SqlId 1
compoundId = SqlId 1
targetId = SqlId 1
it "returns all items with no filters" $ runTestEdna $ do
allProjects <- getActiveProjectNames
allCompounds <- Library.getCompoundNames
allTargets <- Library.getTargetNames
ExperimentsSummaryResp {..} <-
getExperimentsSummary Nothing Nothing Nothing
liftIO $ do
esrMatchedProjects `shouldBe` allProjects
esrMatchedCompounds `shouldBe` allCompounds
esrMatchedTargets `shouldBe` allTargets
it "filters by project" $ runTestEdna $ do
ExperimentsSummaryResp {..} <-
getExperimentsSummary (Just projectId) Nothing Nothing
liftIO $ do
toList esrMatchedProjects `shouldBe` [projectName1, projectName2]
toList esrMatchedCompounds `shouldBe`
[compoundName1, compoundName2, compoundName3, compoundName4]
toList esrMatchedTargets `shouldBe`
[targetName1, targetName2, targetName3]
it "filters by compound" $ runTestEdna $ do
ExperimentsSummaryResp {..} <-
getExperimentsSummary Nothing (Just compoundId) Nothing
liftIO $ do
toList esrMatchedProjects `shouldBe` [projectName1, projectName2]
toList esrMatchedCompounds `shouldBe`
[compoundName1, compoundName2, compoundName3, compoundName4]
toList esrMatchedTargets `shouldBe`
[targetName1, targetName3]
it "filters by target" $ runTestEdna $ do
ExperimentsSummaryResp {..} <-
getExperimentsSummary Nothing Nothing (Just targetId)
liftIO $ do
toList esrMatchedProjects `shouldBe` [projectName1, projectName2]
toList esrMatchedCompounds `shouldBe`
[compoundName1, compoundName2, compoundName3]
toList esrMatchedTargets `shouldBe`
[targetName1, targetName2, targetName3]

describe "getActiveProjectNames" $ do
it "returns names of all projects with experiments" $ runTestEdna $ do
names <- getActiveProjectNames
liftIO $ toList names `shouldBe` [projectName1, projectName2]

describe "getExperimentMetadata" $ do
it "returns correct metadata for all known experiments" $ runTestEdna $ do
forM_ validExperimentIds $ \expId -> do
@@ -234,6 +283,7 @@ gettersSpec = do
it "fails for unknown experiment" $ \ctx -> do
runRIO ctx (getExperimentMetadata unknownSqlId) `shouldThrow`
(== DEExperimentNotFound unknownSqlId)

describe "getExperimentFile" $ do
it "returns correct file name and blob for all known experiments" $ runTestEdna $ do
forM_ validExperimentIds $ \expId -> do
@@ -244,6 +294,7 @@ gettersSpec = do
it "fails for unknown experiment" $ \ctx -> do
runRIO ctx (getExperimentFile unknownSqlId) `shouldThrow`
(== DEExperimentNotFound unknownSqlId)

describe "getSubExperiment" $ do
it "returns correct results for sub-experiments 1-6" $ runTestEdna $ do
resps <- forM validSubExperimentIds $ \subExpId -> do
@@ -256,6 +307,7 @@ gettersSpec = do
it "fails for unknown sub-experiment" $ \ctx -> do
runRIO ctx (getSubExperiment unknownSqlId) `shouldThrow`
(== DESubExperimentNotFound unknownSqlId)

describe "getMeasurements" $ do
it "returns correct measurements for sub-experiments 13-19" $ runTestEdna $ do
[ measurements1
13 changes: 13 additions & 0 deletions backend/test/Test/Gen.hs
Original file line number Diff line number Diff line change
@@ -25,6 +25,7 @@ module Test.Gen
, genCompoundResp
, genTargetResp
, genExperimentsResp
, genExperimentsSummaryResp
, genExperimentResp
, genSubExperimentResp
, genMeasurementResp
@@ -46,6 +47,7 @@ import Universum

import qualified Data.ByteString.Lazy as BL
import qualified Data.HashSet as HS
import qualified Data.Set as Set
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Gen.QuickCheck as HQC
import qualified Hedgehog.Range as Range
@@ -167,6 +169,14 @@ genExperimentsResp :: MonadGen m => m ExperimentsResp
genExperimentsResp =
ExperimentsResp <$> Gen.list (Range.linear 0 5) (genWithId genExperimentResp)

genExperimentsSummaryResp :: MonadGen m => m ExperimentsSummaryResp
genExperimentsSummaryResp = do
let genNames = Set.fromList <$> Gen.list (Range.linear 0 10) genName
esrMatchedProjects <- genNames
esrMatchedCompounds <- genNames
esrMatchedTargets <- genNames
return ExperimentsSummaryResp {..}

genExperimentResp :: MonadGen m => m ExperimentResp
genExperimentResp = do
erProject <- genSqlId
@@ -314,6 +324,9 @@ instance Arbitrary NewSubExperimentReq where
instance Arbitrary ExperimentsResp where
arbitrary = hedgehog genExperimentsResp

instance Arbitrary ExperimentsSummaryResp where
arbitrary = hedgehog genExperimentsSummaryResp

instance Arbitrary ExperimentResp where
arbitrary = hedgehog genExperimentResp

16 changes: 13 additions & 3 deletions backend/test/Test/LibrarySpec.hs
Original file line number Diff line number Diff line change
@@ -22,9 +22,9 @@ import Test.Hspec

import Edna.Library.Error (LibraryError(..))
import Edna.Library.Service
(addMethodology, addProject, deleteMethodology, editChemSoft, editMde, getCompound, getCompounds,
getMethodologies, getMethodology, getProject, getProjects, getTarget, getTargets,
updateMethodology, updateProject)
(addMethodology, addProject, deleteMethodology, editChemSoft, editMde, getCompound,
getCompoundNames, getCompounds, getMethodologies, getMethodology, getProject, getProjects,
getTarget, getTargetNames, getTargets, updateMethodology, updateProject)
import Edna.Library.Web.Types
(CompoundResp(..), MethodologyReq(..), MethodologyResp(..), ProjectReq(..), ProjectResp(..),
TargetResp(..))
@@ -82,6 +82,11 @@ gettersSpec = do
-- have equal addition date, but different IDs
checkTargets (Just (compare `on` (Down . view _1))) (Just paginationDesc) targetsDescDate

describe "getTargetNames" $ do
it "successfully gets names of all targets" $ runTestEdna $ do
names <- getTargetNames
liftIO $ toList names `shouldBe` map (view $ _2 . _1) allExpectedTargets

describe "getCompound" $ do
it "successfully gets known compounds one by one" $ runTestEdna $ do
compounds <- mapM getCompound compoundIds
@@ -104,6 +109,11 @@ gettersSpec = do
(mkPagination paginationDesc)
checkCompounds (Just (compare `on` (Down . snd))) (Just paginationDesc) compoundsDesc

describe "getCompoundNames" $ do
it "successfully gets names of all compounds" $ runTestEdna $ do
names <- getCompoundNames
liftIO $ toList names `shouldBe` map snd allExpectedCompounds

describe "getMethodology" $ do
it "successfully gets known methodologies one by one" $ runTestEdna $ do
methodologies <- mapM getMethodology methodologyIds