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

Switch to GHC 9.6.6 and a new resolver #328

Merged
merged 10 commits into from
Jan 16, 2025
2 changes: 1 addition & 1 deletion poseidon-hs.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ 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 < 0.20.0, cassava, pureMD5, wai, githash,
scotty, 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,
Expand Down
39 changes: 20 additions & 19 deletions src/Poseidon/CLI/Serve.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Poseidon.CLI.Serve (runServer, runServerMainThread, ServeOptions(..)) where

Expand Down Expand Up @@ -50,10 +51,11 @@
getModificationTime)
import System.FilePath ((<.>), (</>))
import Text.ParserCombinators.ReadP (readP_to_S)
import Web.Scotty (ActionM, ScottyM, file, get,
json, middleware, notFound,
param, raise, request, rescue,
scottyApp, text)
import Web.Scotty (ActionM, ScottyM, captureParam,
file, get, json, middleware,
notFound, queryParamMaybe,
request, scottyApp, text)

data ServeOptions = ServeOptions
{ cliArchiveBaseDirs :: [(String, FilePath)]
, cliZipDir :: Maybe FilePath
Expand Down Expand Up @@ -122,7 +124,7 @@
get "/individuals" . conditionOnClientVersion $ do
logRequest logA
pacs <- getItemFromArchiveStore archiveStore
maybeAdditionalColumnsString <- (Just <$> param "additionalJannoColumns") `rescue` (\_ -> return Nothing)
maybeAdditionalColumnsString <- queryParamMaybe "additionalJannoColumns"
indInfo <- case maybeAdditionalColumnsString of
Just "ALL" -> getExtendedIndividualInfo pacs AddColAll -- Nothing means all Janno Columns
Just additionalColumnsString ->
Expand All @@ -135,7 +137,7 @@
get "/bibliography" . conditionOnClientVersion $ do
logRequest logA
pacs <- getItemFromArchiveStore archiveStore
maybeAdditionalBibFieldsString <- (Just <$> param "additionalBibColumns") `rescue` (\_ -> return Nothing)
maybeAdditionalBibFieldsString <- queryParamMaybe "additionalBibColumns"

Check warning on line 140 in src/Poseidon/CLI/Serve.hs

View check run for this annotation

Codecov / codecov/patch

src/Poseidon/CLI/Serve.hs#L140

Added line #L140 was not covered by tests
bibInfo <- case maybeAdditionalBibFieldsString of
Just "ALL" -> getBibliographyInfo pacs AddColAll -- Nothing means all Janno Columns
Just additionalBibFieldsString ->
Expand All @@ -149,26 +151,25 @@
when (isJust maybeZipPath) . get "/zip_file/:package_name" $ do
logRequest logA
zipStore <- getItemFromArchiveStore zipArchiveStore
packageName <- param "package_name"
maybeVersionString <- (Just <$> param "package_version") `rescue` (\_ -> return Nothing)
packageName <- captureParam "package_name"
maybeVersionString <- queryParamMaybe "package_version"
maybeVersion <- case maybeVersionString of
Nothing -> return Nothing
Just versionStr -> case parseVersionString versionStr of
Nothing -> raise . pack $ "Could not parse package version string " ++ versionStr
Nothing -> fail $ "Could not parse package version string " ++ versionStr

Check warning on line 159 in src/Poseidon/CLI/Serve.hs

View check run for this annotation

Codecov / codecov/patch

src/Poseidon/CLI/Serve.hs#L159

Added line #L159 was not covered by tests
Just v -> return $ Just v
case sortOn (Down . fst) . filter ((==packageName) . getPacName . fst) $ zipStore of
[] -> raise . pack $ "unknown package " ++ packageName -- no version found
[] -> fail $ "unknown package " ++ packageName -- no version found

Check warning on line 162 in src/Poseidon/CLI/Serve.hs

View check run for this annotation

Codecov / codecov/patch

src/Poseidon/CLI/Serve.hs#L162

Added line #L162 was not covered by tests
[(pacNameAndVersion, fn)] -> case maybeVersion of -- exactly one version found
Nothing -> file fn
Just v -> if getPacVersion pacNameAndVersion == Just v then file fn else raise . pack $ "Package " ++ packageName ++ " is not available for version " ++ showVersion v
Just v -> if getPacVersion pacNameAndVersion == Just v then file fn else fail $ "Package " ++ packageName ++ " is not available for version " ++ showVersion v
pl@((_, fnLatest) : _) -> case maybeVersion of
Nothing -> file fnLatest
Just v -> case filter ((==Just v) . getPacVersion . fst) pl of
[] -> raise . pack $ "Package " ++ packageName ++ "is not available for version " ++ showVersion v
[] -> fail $ "Package " ++ packageName ++ "is not available for version " ++ showVersion v

Check warning on line 169 in src/Poseidon/CLI/Serve.hs

View check run for this annotation

Codecov / codecov/patch

src/Poseidon/CLI/Serve.hs#L169

Added line #L169 was not covered by tests
[(_, fn)] -> file fn
_ -> error "Should never happen" -- packageCollection should have been filtered to have only one version per package
notFound $ raise "Unknown request"

notFound $ fail "Unknown request"

readArchiveStore :: [(ArchiveName, FilePath)] -> PackageReadOptions -> PoseidonIO (ArchiveStore [PoseidonPackage])
readArchiveStore archBaseDirs pacReadOpts = do
Expand Down Expand Up @@ -207,7 +208,7 @@

conditionOnClientVersion :: ActionM ServerApiReturnType -> ActionM ()
conditionOnClientVersion contentAction = do
maybeClientVersion <- (Just <$> param "client_version") `rescue` (\_ -> return Nothing)
maybeClientVersion <- queryParamMaybe "client_version"
(clientVersion, versionWarnings) <- case maybeClientVersion of
Nothing -> return (version, ["No client_version passed. Assuming latest version " ++ showVersion version])
Just versionString -> case parseVersionString versionString of
Expand Down Expand Up @@ -305,11 +306,11 @@

getItemFromArchiveStore :: ArchiveStore a -> ActionM a
getItemFromArchiveStore store = do
maybeArchiveName <- (Just <$> param "archive") `rescue` (\_ -> return Nothing)
maybeArchiveName <- queryParamMaybe "archive"
case maybeArchiveName of
Nothing -> return . snd . head $ store
Just a -> case lookup a store of
Nothing -> raise . pack $
Nothing -> fail $

Check warning on line 313 in src/Poseidon/CLI/Serve.hs

View check run for this annotation

Codecov / codecov/patch

src/Poseidon/CLI/Serve.hs#L313

Added line #L313 was not covered by tests
"The requested archive named " ++ a ++ " does not exist. Possible archives are " ++
show (map fst store)
Just pacs -> return pacs
Expand Down
3 changes: 1 addition & 2 deletions src/Poseidon/CLI/Validate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,10 +19,9 @@ import Poseidon.SequencingSource (SeqSourceRows (..),
readSeqSourceFile)
import Poseidon.Utils (PoseidonIO, logError, logInfo)

import Control.Monad (unless)
import Control.Monad (forM_, unless)
import Control.Monad.Catch (throwM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.List (forM_)
import qualified Data.ByteString as B
import Data.List (groupBy, intercalate, sortOn)
import Data.Yaml (decodeEither')
Expand Down
9 changes: 2 additions & 7 deletions stack.yaml
Original file line number Diff line number Diff line change
@@ -1,14 +1,9 @@
resolver: lts-21.17
resolver: lts-22.43

packages:
- .
extra-deps:
- table-layout-0.9.1.0
- data-default-instances-base-0.1.0.1
- sequence-formats-1.10.0.0
- pipes-zlib-0.4.4.2
- pipes-ordered-zip-1.2.1
- co-log-0.6.0.2
- ansi-terminal-0.10.3
- chronos-1.1.5
- scotty-0.22
allow-newer: true
53 changes: 9 additions & 44 deletions stack.yaml.lock
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
# https://docs.haskellstack.org/en/stable/topics/lock_files

packages:
- completed:
Expand All @@ -11,13 +11,6 @@ packages:
size: 2216
original:
hackage: table-layout-0.9.1.0
- completed:
hackage: data-default-instances-base-0.1.0.1@sha256:985a13d7103e45a65f06f277b735ef025636014f0d29dd6de998bc7628e09be9,509
pantry-tree:
sha256: 92969ddf22c5f54123fb2bcfbe5917b59a7e6382473b0306bcd8fb7990d9aa1a
size: 242
original:
hackage: data-default-instances-base-0.1.0.1
- completed:
hackage: sequence-formats-1.10.0.0@sha256:502c622fa132a15ae95af85bb3d315ce915f1bbe8c96e7c0a3228e4be2570967,3289
pantry-tree:
Expand All @@ -26,43 +19,15 @@ packages:
original:
hackage: sequence-formats-1.10.0.0
- completed:
hackage: pipes-zlib-0.4.4.2@sha256:eabd5aa29a030ecdeade80cfeb1787adc181bcf8fd378cb7b695b2af6cb26af6,1947
pantry-tree:
sha256: 83893890ab982e322bf7f446cc1d17fc19ce0b9b8041b10b296d86c7622ec050
size: 470
original:
hackage: pipes-zlib-0.4.4.2
- completed:
hackage: pipes-ordered-zip-1.2.1@sha256:1bece0cde4315987da28b6a588dd3345dda8f61bb6894e4e4c9c3cd3a4646746,1453
pantry-tree:
sha256: 099f71b0cecdaee9feae0bbf165491c57082ee259f7b5a593f96cfbccd36ba49
size: 446
original:
hackage: pipes-ordered-zip-1.2.1
- completed:
hackage: co-log-0.6.0.2@sha256:91c14447cb1cbdd6d76317e80d2acd75efe4d964975a57f9731d8af56a4fba7a,6395
pantry-tree:
sha256: 2ed9bcc839c3681796dd7ef797bcd65cf73e20fc0c542c94cae0a2532db7b3ba
size: 1198
original:
hackage: co-log-0.6.0.2
- completed:
hackage: ansi-terminal-0.10.3@sha256:e2fbcef5f980dc234c7ad8e2fa433b0e8109132c9e643bc40ea5608cd5697797,3226
pantry-tree:
sha256: 02f05d52be3ffcf36c78876629cbab80b63420672685371aea4fd10e1c4aabb6
size: 1461
original:
hackage: ansi-terminal-0.10.3
- completed:
hackage: chronos-1.1.5@sha256:ca35be5fdbbb384414226b4467c6d1c8b44defe59a9c8a3af32c1c5fb250c781,3830
hackage: scotty-0.22@sha256:b3c799b3c4896176342062c1140c290ffb9a8d81e6da2ea3e12f7a83cbda78d4,6013
pantry-tree:
sha256: 329bf39a05362a9c1f507a4a529725c757208843b562c55e0b7c88538dc3160f
size: 581
sha256: ec781405d9d771ad8e0b0d6f350b4c4296104665668fc7263ba36839f674d835
size: 2138
original:
hackage: chronos-1.1.5
hackage: scotty-0.22
snapshots:
- completed:
sha256: 85d2382958c178491d3fe50d770a624621f5ab456beef7d31ac7521f780c9bc7
size: 640042
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/17.yaml
original: lts-21.17
sha256: 08bd13ce621b41a8f5e51456b38d5b46d7783ce114a50ab604d6bbab0d002146
size: 720271
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/43.yaml
original: lts-22.43
Loading