-- TODO: Add statistics from TextureGrid
gatherCacheStats :: ImageCache -> IO String
gatherCacheStats ic = do
    bytesTransf <- readIORef $ icBytesTrans ic
    misses      <- readIORef $ icMisses     ic
    diskHits    <- readIORef $ icDiskHits   ic
    memHits     <- readIORef $ icMemHits    ic
    entries     <- atomically . readTVar $ icCacheEntries ic
    requests    <- atomically . readTVar $ icOutstandingReq ic
    let (fetching, fetched, cacheErr, mem) = foldr
         (\(_, v) (fetching', fetched', cacheErr', mem') -> case v of
             Fetching                 -> (fetching' + 1, fetched', cacheErr', mem')
             Fetched (ImageRes w h _) -> (fetching', fetched' + 1, cacheErr', mem' + w * h * 4)
             CacheError _ _           -> (fetching', fetched', cacheErr' + 1, mem')
         )
         ((0, 0, 0, 0) :: (Word64, Word64, Word64, Int))
         (LBM.toList entries)
    return $ printf
        (  "Netw. Recv. Total: %.3fMB · Mem %.3fMB | "
        ++ "Req: %i/%i · Dir: %i/%i | "
        ++ "Misses: %i · DiskHits: %i · MemHits: %i | "
        ++ "Fetching: %i · Fetched: %i · Error: %i"
        )
        (fromIntegral bytesTransf / 1024 / 1024 :: Double)
        (fromIntegral mem         / 1024 / 1024 :: Double)
        (fst $ LBM.size requests)
        (snd $ LBM.size requests)
        (fst $ LBM.size entries)
        (snd $ LBM.size entries)
        misses
        diskHits
        memHits
        fetching
        fetched
        cacheErr


gatherCacheStats :: ImageCache -> IO String
gatherCacheStats ic = do
    bytesTransf <- readIORef $ icBytesTrans ic
    misses      <- readIORef $ icMisses     ic
    diskHits    <- readIORef $ icDiskHits   ic
    memHits     <- readIORef $ icMemHits    ic
    entries     <- atomically . readTVar $ icCacheEntries ic
    requests    <- atomically . readTVar $ icOutstandingReq ic
    let (fetching, fetched, cacheErr, mem) = foldr
         (\(_, v) (fetching', fetched', cacheErr', mem') -> case v of
             Fetching                 -> (fetching' + 1, fetched', cacheErr', mem')
             Fetched (ImageRes w h _) -> (fetching', fetched' + 1, cacheErr', mem' + w * h * 4)
             CacheError _ _           -> (fetching', fetched', cacheErr' + 1, mem')
         )
         ((0, 0, 0, 0) :: (Word64, Word64, Word64, Int))
         (LBM.toList entries)
    return $ printf
        (  "Netw. Recv. Total: %.3fMB · Mem %.3fMB | "
        ++ "Req: %i/%i · Dir: %i/%i | "
        ++ "Misses: %i · DiskHits: %i · MemHits: %i | "
        ++ "Fetching: %i · Fetched: %i · Error: %i"
        )
        (fromIntegral bytesTransf / 1024 / 1024 :: Double)
        (fromIntegral mem         / 1024 / 1024 :: Double)
        (fst $ LBM.size requests)
        (snd $ LBM.size requests)
        (fst $ LBM.size entries)
        (snd $ LBM.size entries)
        misses
        diskHits
        memHits
        fetching
        fetched
        cacheErr
gatherCacheStats ic = do
    bytesTransf <- readIORef $ icBytesTrans ic
    misses      <- readIORef $ icMisses     ic
    diskHits    <- readIORef $ icDiskHits   ic
    memHits     <- readIORef $ icMemHits    ic
    entries     <- atomically . readTVar $ icCacheEntries ic
    requests    <- atomically . readTVar $ icOutstandingReq ic
    let (fetching, fetched, cacheErr, mem) = foldr
         (\(_, v) (fetching', fetched', cacheErr', mem') -> case v of
             Fetching                 -> (fetching' + 1, fetched', cacheErr', mem')
             Fetched (ImageRes w h _) -> (fetching', fetched' + 1, cacheErr', mem' + w * h * 4)
             CacheError _ _           -> (fetching', fetched', cacheErr' + 1, mem')
         )
         ((0, 0, 0, 0) :: (Word64, Word64, Word64, Int))
         (LBM.toList entries)
    return $ printf
        (  "Netw. Recv. Total: %.3fMB · Mem %.3fMB | "
        ++ "Req: %i/%i · Dir: %i/%i | "
        ++ "Misses: %i · DiskHits: %i · MemHits: %i | "
        ++ "Fetching: %i · Fetched: %i · Error: %i"
        )
        (fromIntegral bytesTransf / 1024 / 1024 :: Double)
        (fromIntegral mem         / 1024 / 1024 :: Double)
        (fst $ LBM.size requests)
        (snd $ LBM.size requests)
        (fst $ LBM.size entries)
        (snd $ LBM.size entries)
        misses
        diskHits
        memHits
        fetching
        fetched
        cacheErr