Pg time

beam-core/beam-core.cabal

@@ -84,6 +84,8 @@ library
     ghc-options: -Wcompat
   if flag(werror)
     ghc-options:       -Werror
+  if impl(ghc >= 8.10)
+    default-extensions: TypeFamilyDependencies
 
 flag werror
   description: Enable -Werror during development

beam-postgres/Database/Beam/Postgres.hs

@@ -22,7 +22,7 @@ module Database.Beam.Postgres
     Postgres(..), Pg, liftIOWithHandle
 
     -- ** Postgres syntax
-  , PgCommandSyntax, PgSyntax
+  , PgCommandSyntax(..), PgSyntax
   , PgSelectSyntax, PgInsertSyntax
   , PgUpdateSyntax, PgDeleteSyntax
 

beam-postgres/Database/Beam/Postgres/Connection.hs

@@ -61,7 +61,7 @@ import qualified Control.Monad.Fail as Fail
 import           Data.ByteString (ByteString)
 import           Data.ByteString.Builder (toLazyByteString, byteString)
 import qualified Data.ByteString.Lazy as BL
-import           Data.Maybe (listToMaybe, fromMaybe)
+import           Data.Maybe (listToMaybe, fromMaybe, fromJust)
 import           Data.Proxy
 import           Data.String
 import           Data.Text (Text)
@@ -202,23 +202,29 @@ withPgDebug dbg conn (Pg action) =
                   end <- getTime Monotonic
                   (, Just (end - start)) <$> next x
                 PgStreamDone (Left err) -> pure (Left err, Nothing)
-                PgStreamContinue nextStream ->
-                  let finishUp (PgStreamDone (Right x)) = (, Nothing) <$> next x
+                PgStreamContinue nextStream -> do
+                  start <- getTime Monotonic
+                  let finishUp (PgStreamDone (Right x)) = do
+                            output <- next x
+                            end <- getTime Monotonic
+                            pure (output, Just $ end - start)
                       finishUp (PgStreamDone (Left err)) = pure (Left err, Nothing)
                       finishUp (PgStreamContinue next') = next' Nothing >>= finishUp
 
                       columnCount = fromIntegral $ valuesNeeded (Proxy @Postgres) (Proxy @x)
-                  in do resp <- Pg.queryWith_ (Pg.RP (put columnCount >> ask)) conn (Pg.Query query)
-                        foldM runConsumer (PgStreamContinue nextStream) resp >>= finishUp
-           dbg (decodeUtf8 query <> " Executed in: " <> T.pack (show extime) <> " seconds ") >> return res
+                  resp <- Pg.queryWith_ (Pg.RP (put columnCount >> ask)) conn (Pg.Query query)
+                  foldM runConsumer (PgStreamContinue nextStream) resp >>= finishUp
+           when (extime /= Nothing) $ dbg (decodeUtf8 query <> " Executed in: " <> T.pack (show (((sec (fromJust extime)) * 1000) + ((nsec (fromJust extime)) `div` 1000000)) <> " ms "))
+           when (extime == Nothing) $ dbg (decodeUtf8 query)
+           return res
       step (PgRunReturning (PgCommandSyntax PgCommandTypeDataUpdateReturning syntax) mkProcess next) =
         do query <- pgRenderSyntax conn syntax
 
            start <- getTime Monotonic
            res <- Pg.exec conn query
            end <- getTime Monotonic
            let extime = end - start
-           dbg (decodeUtf8 query <> " Executed in: " <> T.pack (show extime) <> " seconds ")
+           dbg (decodeUtf8 query <> " Executed in: " <> T.pack (show (((sec extime) * 1000) + ((nsec extime) `div` 1000000)) <> " ms "))
            sts <- Pg.resultStatus res
            case sts of
              Pg.TuplesOk -> do
@@ -232,7 +238,7 @@ withPgDebug dbg conn (Pg action) =
            _ <- Pg.execute_ conn (Pg.Query query)
            end <- getTime Monotonic
            let extime = end - start
-           dbg (decodeUtf8 query <> " Executed in: " <> T.pack (show extime) <> " seconds ")
+           dbg (decodeUtf8 query <> " Executed in: " <> T.pack (show (((sec extime) * 1000) + ((nsec extime) `div` 1000000)) <> " ms "))
            let Pg process = mkProcess (Pg (liftF (PgFetchNext id)))
            runF process next stepReturningNone
 

euler.yaml

@@ -0,0 +1,50 @@
+name: beam
+projects:
+  beam-core:
+    location: beam-core
+    allowed-paths:
+    - beam-core.cabal
+    - Database
+    - LICENSE
+  beam-migrate:
+    location: beam-migrate
+    allowed-paths:
+    - beam-migrate.cabal
+    - Database
+    - tools
+    - LICENSE
+  beam-migrate-cli:
+    location: beam-migrate-cli
+    allowed-paths:
+    - beam-migrate-cli.cabal
+    - Database
+    - BeamMigrate.hs
+    - LICENSE
+  beam-postgres:
+    location: beam-postgres
+    allowed-paths:
+    - beam-postgres.cabal
+    - Database
+    - test
+    - LICENSE
+  beam-sqlite:
+    location: beam-sqlite
+    allowed-paths:
+    - beam-sqlite.cabal
+    - Database
+    - examples
+    - LICENSE
+
+default-project: beam-core
+dependencies:
+  euler-build:
+    branch: master
+    revision: 90f393f7f91e1bb9d7b3c0ece1aa919797d1987b
+overrides:
+  haskell-src-exts:
+    source: hackage
+    version: 1.21.1
+    sha256: 06b37iis7hfnc770gb3jn12dy3yngqcfdraynbvy3n7s0hlv2hcw
+    enable-profiling: true
+  haskell-src-meta:
+    enable-profiling: true