Upgrade to lts-8.12

2026-01-11 19:58:28 +01:00 · 2017-06-20 14:55:47 +03:00 · 2017-06-20 14:55:47 +03:00 · 13663c2ce9
commit 13663c2ce9
parent 48e944ab81
12 changed files with 31 additions and 38 deletions
--- a/Data/WebsiteContent.hs
+++ b/Data/WebsiteContent.hs
@ -34,7 +34,7 @@ loadWebsiteContent dir = do
    readMarkdown fp = fmap (markdown def
                        { msXssProtect   = False
                        , msAddHeadingId = True
-                        })
+                        } . fromStrict . decodeUtf8)
               $ readFile $ dir </> fp

 data StackRelease = StackRelease
--- a/Handler/BuildPlan.hs
+++ b/Handler/BuildPlan.hs
@ -3,7 +3,7 @@ module Handler.BuildPlan where

 import Import hiding (get, PackageName (..), Version (..), DList)
 import Stackage.Types
-import Stackage.BuildPlan
+import Stackage.ShowBuildPlan
 import Stackage.Database

 getBuildPlanR :: SnapName -> Handler TypedContent
--- a/Handler/DownloadStack.hs
+++ b/Handler/DownloadStack.hs
@ -9,7 +9,6 @@ import Yesod.GitRepo
 import Data.WebsiteContent
 import Data.Aeson.Parser (json)
 import Data.Conduit.Attoparsec (sinkParser)
-import Data.Monoid (First (..))

 getDownloadStackListR :: Handler Html
 getDownloadStackListR = track "Handler.DownloadStack.getDownloadStackListR" $ do
--- a/Handler/Haddock.hs
+++ b/Handler/Haddock.hs
@ -48,7 +48,7 @@ getHaddockR slug rest
                  ]
                addExtra t@(EventBeginElement "body" _) = [t]
                addExtra t = [t]
-            req <- parseUrl $ unpack $ makeURL slug rest
+            req <- parseRequest $ unpack $ makeURL slug rest
            (_, res) <- acquireResponse req >>= allocateAcquire
            doc <- responseBody res
                $$ eventConduit
--- a/Settings.hs
+++ b/Settings.hs
@ -6,7 +6,6 @@
 module Settings where

 import ClassyPrelude.Yesod
-import Control.Exception           (throw)
 import Data.Aeson                  (Result (..), fromJSON, withObject, (.!=),
                                    (.:?))
 import Data.FileEmbed              (embedFile)
@ -108,7 +107,7 @@ configSettingsYmlBS = $(embedFile configSettingsYml)

 -- | @config/settings.yml@, parsed to a @Value@.
 configSettingsYmlValue :: Value
-configSettingsYmlValue = either throw id $ decodeEither' configSettingsYmlBS
+configSettingsYmlValue = either impureThrow id $ decodeEither' configSettingsYmlBS

 -- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
 compileTimeAppSettings :: AppSettings
--- a/Stackage/Database/Cron.hs
+++ b/Stackage/Database/Cron.hs
@ -17,8 +17,7 @@ import Web.PathPieces (toPathPiece)
 import Filesystem.Path.CurrentOS (parent, fromText, encodeString)
 import Network.HTTP.Types (status200)
 import           Data.Streaming.Network (bindPortTCP)
-import           Network.AWS                   (Credentials (Discover),
-                                                Region (NorthVirginia), newEnv,
+import           Network.AWS                   (Credentials (Discover), newEnv,
                                                send, chunkedFile, defaultChunkSize,
                                                envManager, runAWS)
 import           Control.Monad.Trans.AWS       (trying, _Error)
@ -66,7 +65,7 @@ loadFromS3 develMode man = do
    unless develMode $ handleIO print $ removeTree root
    createTree root

-    req <- parseUrl $ unpack url
+    req <- parseRequest $ unpack url
    let download = do
            suffix <- atomically $ do
                x <- readTVar currSuffixVar
@ -139,11 +138,8 @@ newHoogleLocker toPrint man = mkSingleRun $ \name -> do
    if exists
        then return $ Just (encodeString fp)
        else do
-            req' <- parseUrl $ unpack $ hoogleUrl name
-            let req = req'
-                    { checkStatus = \_ _ _ -> Nothing
-                    , decompress = const False
-                    }
+            req' <- parseRequest $ unpack $ hoogleUrl name
+            let req = req' { decompress = const False }
            withResponse req man $ \res -> if responseStatus res == status200
                then do
                    createTree $ parent (fromString fptmp)
@ -162,7 +158,7 @@ stackageServerCron = do
    void $ catchIO (bindPortTCP 17834 "127.0.0.1") $ \_ ->
        error $ "cabal loader process already running, exiting"

-    env <- newEnv NorthVirginia Discover
+    env <- newEnv Discover
    let upload :: FilePath -> ObjectKey -> IO ()
        upload fp key = do
            let fpgz = fp <.> "gz"
@ -219,7 +215,7 @@ stackageServerCron = do
 createHoogleDB :: StackageDatabase -> Manager -> SnapName -> IO (Maybe FilePath)
 createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do
    putStrLn $ "Creating Hoogle DB for " ++ toPathPiece name
-    req' <- parseUrl $ unpack tarUrl
+    req' <- parseRequest $ unpack tarUrl
    let req = req' { decompress = const True }

    unlessM (isFile (fromString tarFP)) $ withResponse req man $ \res -> do
@ -253,7 +249,9 @@ createHoogleDB db man name = handleAny (\e -> print e $> Nothing) $ do
                          , Just pkg2 <- stripSuffix ".cabal" (pack pkgcabal')
                          , pkg == pkg2
                          , lookup pkg allPackagePairs == Just ver ->
-                              writeFile (tmpdir </> unpack pkg <.> "cabal") cabalLBS
+                                  runConduitRes
+                                $ sourceLazy cabalLBS
+                               .| sinkFile (tmpdir </> unpack pkg <.> "cabal")
                        _ -> return ()
            L.hGetContents h >>= loop . Tar.read

@ -300,7 +298,7 @@ singleDB db sname tmpdir e@(Tar.entryContent -> Tar.NormalFile lbs _) = do
        Just (Entity _ sp)  -> do
            let out = tmpdir </> unpack pkg <.> "txt"
                -- FIXME add @url directive
-            writeFile out lbs
+            runConduitRes $ sourceLazy lbs .| sinkFile out
            return $ singletonMap pkg (snapshotPackageVersion sp)
                {-
                docsUrl = concat
--- a/Stackage/Database/Haddock.hs
+++ b/Stackage/Database/Haddock.hs
@ -56,3 +56,5 @@ hToHtml =
        wrapper 4 = H.h4
        wrapper 5 = H.h5
        wrapper _ = H.h6
+    go (DocMathInline x) = H.pre $ H.code $ toHtml x
+    go (DocMathDisplay x) = H.pre $ H.code $ toHtml x
--- a/Stackage/Database/Types.hs
+++ b/Stackage/Database/Types.hs
@ -6,7 +6,7 @@ module Stackage.Database.Types

 import ClassyPrelude.Conduit
 import Web.PathPieces
-import Data.Aeson.Extra
+import Data.Aeson
 import Data.Text.Read (decimal)
 import Database.Persist
 import Database.Persist.Sql
@ -23,8 +23,7 @@ isNightly :: SnapName -> Bool
 isNightly SNLts{}     = False
 isNightly SNNightly{} = True

-instance ToJSONKey SnapName where
-    toJSONKey = toPathPiece
+instance ToJSONKey SnapName

 instance ToJSON SnapName where
    toJSON = String . toPathPiece
--- a/Stackage/Snapshot/Diff.hs
+++ b/Stackage/Snapshot/Diff.hs
@ -9,7 +9,7 @@ module Stackage.Snapshot.Diff
  ) where

 import           Data.Align
-import           Data.Aeson.Extra
+import           Data.Aeson
 import qualified Data.HashMap.Strict as HashMap
 import           Control.Arrow
 import           ClassyPrelude
@ -30,7 +30,7 @@ newtype SnapshotDiff
 instance ToJSON (WithSnapshotNames SnapshotDiff) where
    toJSON (WithSnapshotNames nameA nameB (SnapshotDiff diff)) =
        object [ "comparing" .= [toPathPiece nameA, toPathPiece nameB]
-               , "diff"      .= Object (toJSONMap (WithSnapshotNames nameA nameB <$> diff))
+               , "diff"      .= toJSON (WithSnapshotNames nameA nameB <$> diff)
               ]

 toDiffList :: SnapshotDiff -> [(PackageName, VersionChange)]
@ -45,7 +45,7 @@ newtype VersionChange = VersionChange { unVersionChange :: These Version Version
                      deriving (Show, Eq, Generic, Typeable)

 instance ToJSON (WithSnapshotNames VersionChange) where
-    toJSON (WithSnapshotNames (toJSONKey -> aKey) (toJSONKey -> bKey) change) =
+    toJSON (WithSnapshotNames (toPathPiece -> aKey) (toPathPiece -> bKey) change) =
        case change of
            VersionChange (This a)    -> object [ aKey .= a ]
            VersionChange (That b)    -> object [ bKey .= b ]
--- a/Types.hs
+++ b/Types.hs
@ -1,7 +1,7 @@
 module Types where

 import ClassyPrelude.Yesod
-import Data.Aeson.Extra
+import Data.Aeson
 import Data.Hashable (hashUsing)
 import Text.Blaze (ToMarkup)
 import Database.Persist.Sql (PersistFieldSql (sqlType))
@ -31,8 +31,7 @@ newtype PackageName = PackageName { unPackageName :: Text }
    deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup, PersistField, IsString)
 instance ToJSON PackageName where
    toJSON = toJSON . unPackageName
-instance ToJSONKey PackageName where
-    toJSONKey = unPackageName
+instance ToJSONKey PackageName
 instance PersistFieldSql PackageName where
    sqlType = sqlType . liftM unPackageName
 newtype Version = Version { unVersion :: Text }
--- a/stack.yaml
+++ b/stack.yaml
@ -1,15 +1,14 @@
-resolver: lts-6.17
+resolver: lts-8.12
 packages:
 - .
 - location:
    git: https://github.com/chrisdone/tagstream-conduit.git
    commit: bacd7444596b2391b0ac302ad649b994b258d271
  extra-dep: true
+- location:
+    git: https://github.com/commercialhaskell/all-cabal-metadata-tool
+    commit: 1a4d8cff4e796ea0049537a38e38ec0a739caf64
+  extra-dep: true
 extra-deps:
-    - prometheus-client-0.1.0.1
-    - prometheus-metrics-ghc-0.1.0.1
-    - wai-middleware-prometheus-0.1.0.1
-    - hoogle-5.0.6
-    - haskell-src-exts-1.19.0
-    - persistent-sqlite-2.2.1.1
-    - yesod-bin-1.5.2.2
+- aws-0.16
+- barrier-0.1.1
--- a/stackage-server.cabal
+++ b/stackage-server.cabal
@ -89,7 +89,6 @@ library
    build-depends:
                    base
                  , aeson
-                  , aeson-extra
                  , aws
                  , barrier
                  , base16-bytestring
@ -168,8 +167,7 @@ library
                  , deepseq
                  , deepseq-generics
                  , auto-update
-                  , stackage-types
-                  , stackage-build-plan
+                  , stackage-curator
                  , yesod-sitemap
                  , streaming-commons
                  , classy-prelude-conduit