diff --git a/beam-core/beam-core.cabal b/beam-core/beam-core.cabal index 63100ebe1..f9e41a30b 100644 --- a/beam-core/beam-core.cabal +++ b/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 diff --git a/beam-postgres/Database/Beam/Postgres.hs b/beam-postgres/Database/Beam/Postgres.hs index 8dd4aa5c3..d30afd8b4 100644 --- a/beam-postgres/Database/Beam/Postgres.hs +++ b/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 diff --git a/beam-postgres/Database/Beam/Postgres/Connection.hs b/beam-postgres/Database/Beam/Postgres/Connection.hs index 0fd135261..96fa47bdb 100644 --- a/beam-postgres/Database/Beam/Postgres/Connection.hs +++ b/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,15 +202,21 @@ 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 @@ -218,7 +224,7 @@ withPgDebug dbg conn (Pg action) = 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 diff --git a/euler.yaml b/euler.yaml new file mode 100644 index 000000000..53737f50c --- /dev/null +++ b/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