mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
improve query logging and top-level exception printing
This commit is contained in:
parent
e3b5ba29b5
commit
48e1653b3e
@ -226,7 +226,6 @@ data Error
|
||||
= DecodeError DecodeError ByteString ErrString
|
||||
deriving stock (Show)
|
||||
deriving anyclass (SqliteExceptionReason)
|
||||
-- instance Exception Error -- FIXME this came from trunk
|
||||
|
||||
newtype NeedTypeForBuiltinMetadata
|
||||
= NeedTypeForBuiltinMetadata Text
|
||||
|
@ -65,27 +65,15 @@ where
|
||||
import Data.Bifunctor (bimap)
|
||||
import qualified Database.SQLite.Simple as Sqlite
|
||||
import qualified Database.SQLite.Simple.FromField as Sqlite
|
||||
import qualified Database.SQLite3.Direct as Sqlite (Database (..))
|
||||
import Debug.RecoverRTTI (anythingToString)
|
||||
import Unison.Debug (debugLogM, debugM)
|
||||
import qualified Unison.Debug as Debug
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite.Connection.Internal (Connection (..))
|
||||
import Unison.Sqlite.Exception
|
||||
import Unison.Sqlite.Sql
|
||||
import UnliftIO (MonadUnliftIO, withRunInIO)
|
||||
import UnliftIO.Exception
|
||||
|
||||
-- | A /non-thread safe/ connection to a SQLite database.
|
||||
data Connection = Connection
|
||||
{ name :: String,
|
||||
file :: FilePath,
|
||||
conn :: Sqlite.Connection
|
||||
}
|
||||
|
||||
instance Show Connection where
|
||||
show (Connection name file (Sqlite.Connection (Sqlite.Database conn))) =
|
||||
"Connection " ++ show name ++ " " ++ show file ++ " " ++ show conn
|
||||
|
||||
-- | Perform an action with a connection to a SQLite database.
|
||||
--
|
||||
-- Note: the connection is created with @PRAGMA foreign_keys = ON@ automatically, to work around the fact that SQLite
|
||||
@ -124,13 +112,33 @@ closeConnection (Connection _ _ conn) =
|
||||
-- 2. Always ignore exceptions thrown by `close` (Mitchell prefers this one)
|
||||
Sqlite.close conn
|
||||
|
||||
-- An internal type, for making prettier debug logs
|
||||
|
||||
data Query = Query
|
||||
{ sql :: Sql,
|
||||
params :: Maybe String,
|
||||
result :: Maybe String
|
||||
}
|
||||
|
||||
instance Show Query where
|
||||
show Query {sql, params, result} =
|
||||
concat
|
||||
[ "Query { sql = ",
|
||||
show sql,
|
||||
maybe "" (\p -> ", params = " ++ show p) params,
|
||||
maybe "" (\r -> ", results = " ++ show r) result,
|
||||
" }"
|
||||
]
|
||||
|
||||
logQuery :: Sql -> Maybe a -> Maybe b -> IO ()
|
||||
logQuery sql params result =
|
||||
Debug.debugM Debug.Sqlite "SQL query" (Query sql (anythingToString <$> params) (anythingToString <$> result))
|
||||
|
||||
-- Without results, with parameters
|
||||
|
||||
execute :: Sqlite.ToRow a => Connection -> Sql -> a -> IO ()
|
||||
execute conn@(Connection _ _ conn0) s params = do
|
||||
debugM Debug.Sqlite "query" s
|
||||
debugM Debug.Sqlite "params" (anythingToString params)
|
||||
debugLogM Debug.Sqlite "----------"
|
||||
logQuery s (Just params) Nothing
|
||||
Sqlite.execute conn0 (coerce s) params `catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
@ -142,9 +150,7 @@ execute conn@(Connection _ _ conn0) s params = do
|
||||
|
||||
executeMany :: Sqlite.ToRow a => Connection -> Sql -> [a] -> IO ()
|
||||
executeMany conn@(Connection _ _ conn0) s params = do
|
||||
debugM Debug.Sqlite "query" s
|
||||
debugM Debug.Sqlite "params" (anythingToString params)
|
||||
debugLogM Debug.Sqlite "----------"
|
||||
logQuery s (Just params) Nothing
|
||||
Sqlite.executeMany conn0 (coerce s) params `catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
@ -158,8 +164,7 @@ executeMany conn@(Connection _ _ conn0) s params = do
|
||||
|
||||
execute_ :: Connection -> Sql -> IO ()
|
||||
execute_ conn@(Connection _ _ conn0) s = do
|
||||
debugM Debug.Sqlite "query" s
|
||||
debugLogM Debug.Sqlite "----------"
|
||||
logQuery s Nothing Nothing
|
||||
Sqlite.execute_ conn0 (coerce s) `catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
@ -172,23 +177,19 @@ execute_ conn@(Connection _ _ conn0) s = do
|
||||
-- With results, with parameters, without checks
|
||||
|
||||
queryListRow :: (Sqlite.FromRow b, Sqlite.ToRow a) => Connection -> Sql -> a -> IO [b]
|
||||
queryListRow conn@(Connection _ _ conn0) s params =
|
||||
doQueryListRow `catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
{ connection = conn,
|
||||
exception = SomeSqliteExceptionReason exception,
|
||||
params = Just params,
|
||||
sql = s
|
||||
}
|
||||
where
|
||||
doQueryListRow = do
|
||||
debugM Debug.Sqlite "query" s
|
||||
debugM Debug.Sqlite "params" (anythingToString params)
|
||||
result <- Sqlite.query conn0 (coerce s) params
|
||||
debugM Debug.Sqlite "result" (anythingToString result)
|
||||
debugLogM Debug.Sqlite "----------"
|
||||
pure result
|
||||
queryListRow conn@(Connection _ _ conn0) s params = do
|
||||
result <-
|
||||
Sqlite.query conn0 (coerce s) params
|
||||
`catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
{ connection = conn,
|
||||
exception = SomeSqliteExceptionReason exception,
|
||||
params = Just params,
|
||||
sql = s
|
||||
}
|
||||
logQuery s (Just params) (Just result)
|
||||
pure result
|
||||
|
||||
queryListCol :: forall a b. (Sqlite.FromField b, Sqlite.ToRow a) => Connection -> Sql -> a -> IO [b]
|
||||
queryListCol conn s params =
|
||||
@ -308,22 +309,19 @@ queryOneColCheck conn s params check =
|
||||
-- With results, without parameters, without checks
|
||||
|
||||
queryListRow_ :: Sqlite.FromRow a => Connection -> Sql -> IO [a]
|
||||
queryListRow_ conn@(Connection _ _ conn0) s =
|
||||
doQueryListRow_ `catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
{ connection = conn,
|
||||
exception = SomeSqliteExceptionReason exception,
|
||||
params = Nothing,
|
||||
sql = s
|
||||
}
|
||||
where
|
||||
doQueryListRow_ = do
|
||||
debugM Debug.Sqlite "query" s
|
||||
result <- Sqlite.query_ conn0 (coerce s)
|
||||
debugM Debug.Sqlite "result" (anythingToString result)
|
||||
debugLogM Debug.Sqlite "----------"
|
||||
pure result
|
||||
queryListRow_ conn@(Connection _ _ conn0) s = do
|
||||
result <-
|
||||
Sqlite.query_ conn0 (coerce s)
|
||||
`catch` \(exception :: Sqlite.SQLError) ->
|
||||
throwSqliteQueryException
|
||||
SqliteQueryExceptionInfo
|
||||
{ connection = conn,
|
||||
exception = SomeSqliteExceptionReason exception,
|
||||
params = Nothing,
|
||||
sql = s
|
||||
}
|
||||
logQuery s Nothing (Just result)
|
||||
pure result
|
||||
|
||||
queryListCol_ :: forall a. Sqlite.FromField a => Connection -> Sql -> IO [a]
|
||||
queryListCol_ conn s =
|
||||
|
17
lib/unison-sqlite/src/Unison/Sqlite/Connection/Internal.hs
Normal file
17
lib/unison-sqlite/src/Unison/Sqlite/Connection/Internal.hs
Normal file
@ -0,0 +1,17 @@
|
||||
module Unison.Sqlite.Connection.Internal
|
||||
( Connection (..),
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Database.SQLite.Simple as Sqlite
|
||||
|
||||
-- | A /non-thread safe/ connection to a SQLite database.
|
||||
data Connection = Connection
|
||||
{ name :: String,
|
||||
file :: FilePath,
|
||||
conn :: Sqlite.Connection
|
||||
}
|
||||
|
||||
instance Show Connection where
|
||||
show (Connection name file _conn) =
|
||||
"Connection { name = " ++ show name ++ ", file = " ++ show file ++ " }"
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE ImplicitParams #-}
|
||||
|
||||
-- | Sqlite exception utils.
|
||||
module Unison.Sqlite.Exception
|
||||
( -- * @SomeSqliteException@
|
||||
@ -24,7 +26,9 @@ import Data.Typeable (cast)
|
||||
import Data.Void (Void)
|
||||
import qualified Database.SQLite.Simple as Sqlite
|
||||
import Debug.RecoverRTTI (anythingToString)
|
||||
import GHC.Stack (currentCallStack)
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite.Connection.Internal (Connection)
|
||||
import Unison.Sqlite.Sql
|
||||
import UnliftIO.Exception
|
||||
|
||||
@ -110,7 +114,8 @@ data SqliteQueryException = SqliteQueryException
|
||||
-- | The inner exception. It is intentionally not 'SomeException', so that calling code cannot accidentally
|
||||
-- 'throwIO' domain-specific exception types, but must instead use a @*Check@ query variant.
|
||||
exception :: SomeSqliteExceptionReason,
|
||||
connection :: String,
|
||||
callStack :: [String],
|
||||
connection :: Connection,
|
||||
threadId :: ThreadId
|
||||
}
|
||||
deriving stock (Show)
|
||||
@ -128,22 +133,24 @@ isSqliteBusyException SqliteQueryException {exception = SomeSqliteExceptionReaso
|
||||
Just (Sqlite.SQLError Sqlite.ErrorBusy _ _) -> True
|
||||
_ -> False
|
||||
|
||||
data SqliteQueryExceptionInfo params connection = SqliteQueryExceptionInfo
|
||||
{ connection :: connection,
|
||||
data SqliteQueryExceptionInfo params = SqliteQueryExceptionInfo
|
||||
{ connection :: Connection,
|
||||
sql :: Sql,
|
||||
params :: Maybe params,
|
||||
exception :: SomeSqliteExceptionReason
|
||||
}
|
||||
|
||||
throwSqliteQueryException :: Show connection => SqliteQueryExceptionInfo params connection -> IO a
|
||||
throwSqliteQueryException :: SqliteQueryExceptionInfo params -> IO a
|
||||
throwSqliteQueryException SqliteQueryExceptionInfo {connection, exception, params, sql} = do
|
||||
threadId <- myThreadId
|
||||
callStack <- currentCallStack
|
||||
throwIO
|
||||
SqliteQueryException
|
||||
{ sql,
|
||||
params = maybe "" anythingToString params,
|
||||
exception,
|
||||
connection = show connection,
|
||||
callStack,
|
||||
connection,
|
||||
threadId
|
||||
}
|
||||
|
||||
|
@ -19,6 +19,7 @@ library
|
||||
exposed-modules:
|
||||
Unison.Sqlite
|
||||
Unison.Sqlite.Connection
|
||||
Unison.Sqlite.Connection.Internal
|
||||
Unison.Sqlite.DB
|
||||
Unison.Sqlite.Transaction
|
||||
other-modules:
|
||||
|
@ -30,6 +30,7 @@ dependencies:
|
||||
- mtl
|
||||
- transformers
|
||||
- open-browser
|
||||
- pretty-simple
|
||||
- random >= 1.2.0
|
||||
- regex-tdfa
|
||||
- stm
|
||||
|
@ -19,7 +19,6 @@ module Unison.Codebase.TranscriptParser
|
||||
where
|
||||
|
||||
import Control.Concurrent.STM (atomically)
|
||||
import Control.Error (rightMay)
|
||||
import Control.Lens (view)
|
||||
import qualified Crypto.Random as Random
|
||||
import qualified Data.Char as Char
|
||||
@ -58,9 +57,6 @@ import qualified Unison.Runtime.Interface as RTI
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Util.Pretty as P
|
||||
import qualified Unison.Util.TQueue as Q
|
||||
import qualified Unison.Codebase.Editor.Output as Output
|
||||
import Control.Lens (view)
|
||||
import qualified Unison.Codebase.Editor.HandleInput as HandleInput
|
||||
import qualified UnliftIO
|
||||
import Prelude hiding (readFile, writeFile)
|
||||
|
||||
|
@ -10,7 +10,6 @@ where
|
||||
import Compat (withInterruptHandler)
|
||||
import qualified Control.Concurrent.Async as Async
|
||||
import Control.Concurrent.STM (atomically)
|
||||
import Control.Error (rightMay)
|
||||
import Control.Exception (catch, finally)
|
||||
import Control.Lens (view)
|
||||
import qualified Crypto.Random as Random
|
||||
@ -18,9 +17,11 @@ import Data.Configurator.Types (Config)
|
||||
import Data.IORef
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy.IO as Text.Lazy
|
||||
import qualified System.Console.Haskeline as Line
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import Text.Pretty.Simple (pShow)
|
||||
import Unison.Codebase (Codebase)
|
||||
import qualified Unison.Codebase as Codebase
|
||||
import Unison.Codebase.Branch (Branch)
|
||||
@ -46,13 +47,6 @@ import qualified Unison.Server.CodebaseServer as Server
|
||||
import Unison.Symbol (Symbol)
|
||||
import qualified Unison.Util.Pretty as P
|
||||
import qualified Unison.Util.TQueue as Q
|
||||
import qualified Unison.CommandLine.Welcome as Welcome
|
||||
import Control.Lens (view)
|
||||
import UnliftIO (catchSyncOrAsync, throwIO, withException)
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Unison.Codebase.Editor.Output (Output)
|
||||
import qualified Unison.Codebase.Editor.HandleInput.LoopState as LoopState
|
||||
import qualified Unison.Codebase.Editor.HandleInput as HandleInput
|
||||
import qualified UnliftIO
|
||||
|
||||
getUserInput ::
|
||||
@ -234,7 +228,7 @@ main dir welcome initialPath (config, cancelConfig) initialInputs runtime codeba
|
||||
`finally` cleanup
|
||||
where
|
||||
printException :: SomeException -> IO ()
|
||||
printException e = hPutStrLn stderr ("Encountered Exception: " <> show (e :: SomeException))
|
||||
printException e = Text.Lazy.hPutStrLn stderr ("Encountered exception:\n" <> pShow e)
|
||||
|
||||
-- | Installs a posix interrupt handler for catching SIGINT.
|
||||
-- This replaces GHC's default sigint handler which throws a UserInterrupt async exception
|
||||
|
@ -97,6 +97,7 @@ library
|
||||
, mtl
|
||||
, nonempty-containers
|
||||
, open-browser
|
||||
, pretty-simple
|
||||
, random >=1.2.0
|
||||
, regex-tdfa
|
||||
, semialign
|
||||
@ -172,6 +173,7 @@ executable integration-tests
|
||||
, mtl
|
||||
, nonempty-containers
|
||||
, open-browser
|
||||
, pretty-simple
|
||||
, process
|
||||
, random >=1.2.0
|
||||
, regex-tdfa
|
||||
@ -244,6 +246,7 @@ executable transcripts
|
||||
, mtl
|
||||
, nonempty-containers
|
||||
, open-browser
|
||||
, pretty-simple
|
||||
, process
|
||||
, random >=1.2.0
|
||||
, regex-tdfa
|
||||
@ -319,6 +322,7 @@ executable unison
|
||||
, nonempty-containers
|
||||
, open-browser
|
||||
, optparse-applicative >=0.16.1.0
|
||||
, pretty-simple
|
||||
, random >=1.2.0
|
||||
, regex-tdfa
|
||||
, semialign
|
||||
@ -400,6 +404,7 @@ test-suite tests
|
||||
, mtl
|
||||
, nonempty-containers
|
||||
, open-browser
|
||||
, pretty-simple
|
||||
, random >=1.2.0
|
||||
, regex-tdfa
|
||||
, semialign
|
||||
|
Loading…
Reference in New Issue
Block a user