debug: fix traceStack call

.envrc

@@ -0,0 +1 @@
+use flake

flake.lock

@@ -0,0 +1,44 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "locked": {
+        "lastModified": 1619345332,
+        "narHash": "sha256-qHnQkEp1uklKTpx3MvKtY6xzgcqXDsz5nLilbbuL+3A=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "2ebf2558e5bf978c7fb8ea927dfaed8fefab2e28",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "ref": "master",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1620323686,
+        "narHash": "sha256-+gfcE3YTGl+Osc8HzOUXSFO8/0PAK4J8ZxCXZ4hjXHI=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "dfacb8329b2236688b9a1e705116203a213b283a",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "master",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-utils": "flake-utils",
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

@@ -0,0 +1,30 @@
+{
+  inputs = {
+    nixpkgs = {
+      type = "github";
+      owner = "NixOS";
+      repo = "nixpkgs";
+      ref = "master";
+    };
+    flake-utils = {
+      type = "github";
+      owner = "numtide";
+      repo = "flake-utils";
+      ref = "master";
+    };
+  };
+
+  outputs = { self, nixpkgs, flake-utils, ... }: flake-utils.lib.eachDefaultSystem
+    (system:
+      let pkgs = import nixpkgs {
+            inherit system;
+            config.allowUnfree = true;
+          };
+      in {
+        devShell = pkgs.mkShell {
+          name = "uni2work-yesod";
+          nativeBuildInputs = with pkgs.haskellPackages; [ stack ];
+        };
+      }
+    );
+}

nixpkgs.nix

@@ -0,0 +1,8 @@
+import (
+  let
+    lock = builtins.fromJSON (builtins.readFile ./flake.lock);
+  in fetchTarball {
+    url = "https://api.github.com/repos/NixOS/nixpkgs/tarball/${lock.nodes.nixpkgs.locked.rev}";
+    sha256 = lock.nodes.nixpkgs.locked.narHash;
+  }
+)

stack.nix

@@ -0,0 +1,14 @@
+{ ghc, nixpkgs ? import ./nixpkgs.nix }:
+
+let
+  # haskellPackages = import ./stackage.nix { inherit nixpkgs; };
+  haskellPackages = pkgs.haskellPackages;
+  inherit (nixpkgs {}) pkgs;
+in pkgs.haskell.lib.buildStackProject {
+  inherit ghc;
+  inherit (haskellPackages) stack;
+  name = "stackenv";
+  buildInputs = with pkgs;
+    [ zlib
+    ];
+}

stack.yaml

@@ -1,4 +1,10 @@
-resolver: lts-15.5
+nix:
+  packages: []
+  pure: false
+  shell-file: ./stack.nix
+  add-gc-roots: true
+
+resolver: lts-16.31
 packages:
 - ./yesod-core
 - ./yesod-static

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 491372
+    size: 534126
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/5.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml
-    sha256: 1b549cfff328040c382a70a84a2087aac8dab6d778bf92f32a93a771a1980dfc
+    sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6
-  original: lts-15.5
+  original: lts-16.31

yesod-core/src/Yesod/Core/Handler.hs

@@ -1149,9 +1149,9 @@ cached action = do
     eres <- Cache.cached cache action
     case eres of
       Right res -> return res
-      Left (newCache, res) -> do
+      Left (updateCache, res) -> do
           gs <- get
-          let merged = newCache `HM.union` ghsCache gs
+          let merged = updateCache $ ghsCache gs
           put $ gs { ghsCache = merged }
           return res
 
@@ -1192,9 +1192,9 @@ cachedBy k action = do
     eres <- Cache.cachedBy cache k action
     case eres of
       Right res -> return res
-      Left (newCache, res) -> do
+      Left (updateCache, res) -> do
           gs <- get
-          let merged = newCache `HM.union` ghsCacheBy gs
+          let merged = updateCache $ ghsCacheBy gs
           put $ gs { ghsCacheBy = merged }
           return res
 

yesod-core/src/Yesod/Core/Internal/Run.hs

@@ -40,6 +40,8 @@ import           Yesod.Routes.Class           (Route, renderRoute)
 import           Control.DeepSeq              (($!!), NFData)
 import           UnliftIO.Exception
 
+import Debug.Trace (traceStack)
+
 -- | Convert a synchronous exception into an ErrorResponse
 toErrorHandler :: SomeException -> IO ErrorResponse
 toErrorHandler e0 = handleAny errFromShow $
@@ -207,7 +209,8 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
        -> ErrorResponse
        -> YesodApp
 safeEh log' er req = do
-    liftIO $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError
+    traceStack "safeEh debug trace:" $ liftIO
+           $ log' $(qLocation >>= liftLoc) "yesod-core" LevelError
            $ toLogStr $ "Error handler errored out: " ++ show er
     return $ YRPlain
         H.status500

yesod-core/src/Yesod/Core/TypeCache.hs

@@ -32,12 +32,12 @@ type KeyedTypeMap = HashMap (TypeRep, ByteString) Dynamic
 cached :: (Monad m, Typeable a)
        => TypeMap
        -> m a                       -- ^ cache the result of this action
-       -> m (Either (TypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
+       -> m (Either (TypeMap -> TypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
 cached cache action = case cacheGet cache of
     Just val -> return $ Right val
     Nothing -> do
         val <- action
-        return $ Left (cacheSet val cache, val)
+        return $ Left (cacheSet val, val)
 
 -- | Retrieves a value from the cache
 --
@@ -72,12 +72,12 @@ cachedBy :: (Monad m, Typeable a)
          => KeyedTypeMap
          -> ByteString                     -- ^ a cache key
          -> m a                            -- ^ cache the result of this action
-         -> m (Either (KeyedTypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
+         -> m (Either (KeyedTypeMap -> KeyedTypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
 cachedBy cache k action = case cacheByGet k cache of
     Just val -> return $ Right val
     Nothing -> do
         val <- action
-        return $ Left (cacheBySet k val cache, val)
+        return $ Left (cacheBySet k val, val)
 
 -- | Retrieves a value from the keyed cache
 --
@@ -93,4 +93,4 @@ cacheByGet key c = res
 --
 -- @since 1.6.10
 cacheBySet :: Typeable a => ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
-cacheBySet key v cache = insert (typeOf v, key) (toDyn v) cache
+cacheBySet key v cache = insert (typeOf v, key) (toDyn v) cache