{-# LANGUAGE OverloadedStrings #-}

module IpeDb.Eventlog.Index (
  -- * High level API for interacting with the database
  withDatabase,
  generateInfoProvDb,
  findOneInfoProv,
  findAllInfoProvs,

  -- * Low level API for interacting with the database
  setupDb,
  setupTables,
  setupIndexing,
  insertInfoProv,
  upsertInfoProvStrings,

  -- * ghc-events specific helpers
  insertInfoProvData,
)
where

import Data.Foldable (traverse_)
import qualified Database.SQLite.Simple as Sqlite
import Database.SQLite.Simple.Types (Only (..))
import qualified GHC.RTS.Events as GhcEvents
import IpeDb.InfoProv as Ipe
import IpeDb.Table as Table

findOneInfoProv :: Sqlite.Connection -> IpeId -> IO (Maybe InfoProv)
findOneInfoProv :: Connection -> IpeId -> IO (Maybe InfoProv)
findOneInfoProv Connection
conn IpeId
ipeId = do
  r <- Connection -> Query -> Only IpeId -> IO [InfoProv]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
Sqlite.query Connection
conn Query
findInfoTableQuery (IpeId -> Only IpeId
forall a. a -> Only a
Only IpeId
ipeId)
  case r of
    [InfoProv
ipe] -> Maybe InfoProv -> IO (Maybe InfoProv)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe InfoProv -> IO (Maybe InfoProv))
-> Maybe InfoProv -> IO (Maybe InfoProv)
forall a b. (a -> b) -> a -> b
$ InfoProv -> Maybe InfoProv
forall a. a -> Maybe a
Just InfoProv
ipe
    [InfoProv]
_ -> Maybe InfoProv -> IO (Maybe InfoProv)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe InfoProv -> IO (Maybe InfoProv))
-> Maybe InfoProv -> IO (Maybe InfoProv)
forall a b. (a -> b) -> a -> b
$ Maybe InfoProv
forall a. Maybe a
Nothing

findAllInfoProvs :: Sqlite.Connection -> IO [InfoProv]
findAllInfoProvs :: Connection -> IO [InfoProv]
findAllInfoProvs Connection
conn = do
  Connection -> Query -> () -> IO [InfoProv]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
Sqlite.query Connection
conn Query
findAllInfoTablesQuery ()

generateInfoProvDb :: Sqlite.Connection -> FilePath -> IO ()
generateInfoProvDb :: Connection -> FilePath -> IO ()
generateInfoProvDb Connection
conn FilePath
fp = do
  Connection -> IO ()
setupDb Connection
conn
  FilePath -> IO (Either FilePath EventLog)
GhcEvents.readEventLogFromFile FilePath
fp IO (Either FilePath EventLog)
-> (Either FilePath EventLog -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left FilePath
err -> FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
err
    Right (GhcEvents.EventLog Header
_h (GhcEvents.Data [Event]
es)) -> Connection -> IO () -> IO ()
forall a. Connection -> IO a -> IO a
Sqlite.withExclusiveTransaction Connection
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Connection -> [Event] -> IO ()
forall (t :: * -> *). Foldable t => Connection -> t Event -> IO ()
insertInfoProvData Connection
conn [Event]
es

setupDb :: Sqlite.Connection -> IO ()
setupDb :: Connection -> IO ()
setupDb Connection
conn = do
  Connection -> IO () -> IO ()
forall a. Connection -> IO a -> IO a
Sqlite.withExclusiveTransaction Connection
conn (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
setupTables Connection
conn
  Connection -> IO ()
setupIndexing Connection
conn

withDatabase :: FilePath -> (Sqlite.Connection -> IO a) -> IO a
withDatabase :: forall a. FilePath -> (Connection -> IO a) -> IO a
withDatabase FilePath
fp Connection -> IO a
act = FilePath -> (Connection -> IO a) -> IO a
forall a. FilePath -> (Connection -> IO a) -> IO a
Sqlite.withConnection FilePath
fp ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
  Connection -> IO a
act Connection
conn

-- ----------------------------------------------------------------------------
-- Low Level Sqlite api
-- ----------------------------------------------------------------------------

setupTables :: Sqlite.Connection -> IO ()
setupTables :: Connection -> IO ()
setupTables Connection
conn = do
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
dropStringTableStmt
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
dropInfoProvTableStmt
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
dropInfoProvTableViewStmt
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
stringTableStmt
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
infoProvTableStmt
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
infoProvTableViewStmt

setupIndexing :: Sqlite.Connection -> IO ()
setupIndexing :: Connection -> IO ()
setupIndexing Connection
conn = do
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"PRAGMA synchronous = OFF;"
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"PRAGMA journal_mode = OFF;"
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"PRAGMA temp_store = MEMORY;"
  Connection -> Query -> IO ()
Sqlite.execute_ Connection
conn Query
"PRAGMA locking_mode = EXCLUSIVE;"

insertInfoProv :: Sqlite.Connection -> InfoProv -> IO ()
insertInfoProv :: Connection -> InfoProv -> IO ()
insertInfoProv Connection
conn InfoProv
prov = do
  row <- Connection -> InfoProv -> IO InfoProvRow
upsertInfoProvStrings Connection
conn InfoProv
prov
  _ <- Sqlite.execute conn insertInfoTableQuery row
  pure ()

upsertInfoProvStrings :: Sqlite.Connection -> InfoProv -> IO InfoProvRow
upsertInfoProvStrings :: Connection -> InfoProv -> IO InfoProvRow
upsertInfoProvStrings Connection
conn InfoProv
prov = do
  Connection -> Query -> [Only Text] -> IO ()
forall q. ToRow q => Connection -> Query -> [q] -> IO ()
Sqlite.executeMany
    Connection
conn
    Query
insertOrIgnoreString
    [ Text -> Only Text
forall a. a -> Only a
Only InfoProv
prov.tableName
    , Text -> Only Text
forall a. a -> Only a
Only InfoProv
prov.typeDesc
    , Text -> Only Text
forall a. a -> Only a
Only InfoProv
prov.label
    , Text -> Only Text
forall a. a -> Only a
Only InfoProv
prov.moduleName
    , Text -> Only Text
forall a. a -> Only a
Only InfoProv
prov.srcLoc
    ]
  [(taId, tyId, labelId, modId, srcLocId)] <-
    Connection
-> Query
-> (Text, Text, Text, Text, Text)
-> IO [(Int64, Int64, Int64, Int64, Int64)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
Sqlite.query
      Connection
conn
      Query
getIpeStrings
      ( InfoProv
prov.typeDesc
      , InfoProv
prov.label
      , InfoProv
prov.moduleName
      , InfoProv
prov.srcLoc
      , InfoProv
prov.tableName
      )
  pure
    InfoProvRow
      { Table.infoId = prov.infoId
      , Table.tableName = taId
      , Table.closureDesc = prov.closureDesc
      , Table.typeDesc = tyId
      , Table.label = labelId
      , Table.moduleName = modId
      , Table.srcLoc = srcLocId
      }

-- ----------------------------------------------------------------------------
-- Eventlog processing
-- ----------------------------------------------------------------------------

insertInfoProvData :: (Foldable t) => Sqlite.Connection -> t GhcEvents.Event -> IO ()
insertInfoProvData :: forall (t :: * -> *). Foldable t => Connection -> t Event -> IO ()
insertInfoProvData Connection
conn t Event
es = (Event -> IO ()) -> t Event -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Connection -> Event -> IO ()
processIpeEvents Connection
conn) t Event
es

processIpeEvents :: Sqlite.Connection -> GhcEvents.Event -> IO ()
processIpeEvents :: Connection -> Event -> IO ()
processIpeEvents Connection
conn Event
ev = case EventInfo -> Maybe InfoProv
eventInfoToInfoProv (Event -> EventInfo
GhcEvents.evSpec Event
ev) of
  Maybe InfoProv
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Just InfoProv
infoProv -> Connection -> InfoProv -> IO ()
insertInfoProv Connection
conn InfoProv
infoProv

eventInfoToInfoProv :: GhcEvents.EventInfo -> Maybe InfoProv
eventInfoToInfoProv :: EventInfo -> Maybe InfoProv
eventInfoToInfoProv EventInfo
ev = case EventInfo
ev of
  it :: EventInfo
it@GhcEvents.InfoTableProv{} ->
    InfoProv -> Maybe InfoProv
forall a. a -> Maybe a
Just
      InfoProv
        { infoId :: IpeId
Ipe.infoId = Word64 -> IpeId
IpeId (Word64 -> IpeId) -> Word64 -> IpeId
forall a b. (a -> b) -> a -> b
$ EventInfo -> Word64
GhcEvents.itInfo EventInfo
it
        , tableName :: Text
Ipe.tableName = EventInfo -> Text
GhcEvents.itTableName EventInfo
it
        , closureDesc :: Int64
Ipe.closureDesc = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ EventInfo -> Int
GhcEvents.itClosureDesc EventInfo
it
        , typeDesc :: Text
Ipe.typeDesc = EventInfo -> Text
GhcEvents.itTyDesc EventInfo
it
        , label :: Text
Ipe.label = EventInfo -> Text
GhcEvents.itLabel EventInfo
it
        , moduleName :: Text
Ipe.moduleName = EventInfo -> Text
GhcEvents.itModule EventInfo
it
        , srcLoc :: Text
Ipe.srcLoc = EventInfo -> Text
GhcEvents.itSrcLoc EventInfo
it
        }
  EventInfo
_ -> Maybe InfoProv
forall a. Maybe a
Nothing