Merge pull request #328 from poseidon-framework/ghc966

Switch to GHC 9.6.6 and a new resolver

poseidon-hs.cabal

@@ -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,

src/Poseidon/CLI/Serve.hs

@@ -50,10 +50,11 @@ import           System.Directory             (createDirectoryIfMissing,
                                                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
@@ -122,7 +123,7 @@ runServer (ServeOptions archBaseDirs maybeZipPath port ignoreChecksums certFiles
         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 ->
@@ -135,7 +136,7 @@ runServer (ServeOptions archBaseDirs maybeZipPath port ignoreChecksums certFiles
         get "/bibliography" . conditionOnClientVersion $ do
             logRequest logA
             pacs <- getItemFromArchiveStore archiveStore
-            maybeAdditionalBibFieldsString <- (Just <$> param "additionalBibColumns") `rescue` (\_ -> return Nothing)
+            maybeAdditionalBibFieldsString <- queryParamMaybe "additionalBibColumns"
             bibInfo <- case maybeAdditionalBibFieldsString of
                     Just "ALL" -> getBibliographyInfo pacs AddColAll -- Nothing means all Janno Columns
                     Just additionalBibFieldsString ->
@@ -149,26 +150,25 @@ runServer (ServeOptions archBaseDirs maybeZipPath port ignoreChecksums certFiles
         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
                     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
                 [(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
                         [(_, 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
@@ -207,7 +207,7 @@ parseVersionString vStr = case filter ((=="") . snd) $ readP_to_S parseVersion v
 
 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
@@ -305,11 +305,11 @@ logRequest logA = do
 
 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 $
                 "The requested archive named " ++ a ++ " does not exist. Possible archives are " ++
                 show (map fst store)
             Just pacs -> return pacs

src/Poseidon/CLI/Validate.hs

@@ -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')

stack.yaml

@@ -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
+- table-layout-0.9.1.0 # not available any more in lts-22.43
+- sequence-formats-1.10.0.0 # not available yet in lts-22.43
+- scotty-0.22 # not available yet in lts-22.43
 allow-newer: true

stack.yaml.lock

@@ -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:
@@ -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:
@@ -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