content: {-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, CPP #-}
  
  -- Stuff on disk on the server
  module Development.Bake.Server.Database(
      PointId, RunId, StateId, PatchId, patchIds, fromPatchIds, patchIdsSuperset,
      saTable, saId, saState, saCreate, saPoint, saDuration,
  #if OPALEYE
      SATable(..), SATableVal, SATableCol, saTable__,
      PCTable(..), PCTableVal, PCTableCol, pcTable__,
  #endif
      pcTable, pcId, pcPatch, pcAuthor, pcQueue, pcStart, pcDelete, pcSupersede, pcReject, pcPlausible, pcMerge,
      rjTable, rjPatch, rjTest, rjRun,
      ptTable, ptId, ptState, ptPatches,
      skTable, skTest, skComment,
      tsTable, tsPoint, tsTest,
      rnTable, rnId, rnPoint, rnTest, rnSuccess, rnClient, rnStart, rnDuration,
      create, save
      ) where
  
  import Development.Bake.Core.Type
  import Data.String
  import Control.Exception
  import General.Extra
  import qualified Database.SQLite3 as SQ
  import Database.SQLite.Simple
  import Database.SQLite.Simple.FromField
  import Database.SQLite.Simple.ToField
  import Data.Hashable
  import Data.List.Extra
  import Control.Monad
  import Data.Maybe
  import Safe
  import General.Database
  import Prelude
  
  #if OPALEYE
  import Opaleye hiding (Column)
  import Data.Profunctor.Product.TH(makeAdaptorAndInstance)
  import qualified Opaleye as O
  import qualified Opaleye.Internal.RunQuery as O
  #endif
  
  
  newtype PointId = PointId Int deriving (ToField, FromField, TypeField, Eq, Hashable)
  newtype RunId = RunId Int deriving (Eq, ToField, FromField, TypeField)
  newtype StateId = StateId Int deriving (ToField, FromField, TypeField)
  newtype PatchId = PatchId Int deriving (ToField, FromField, TypeField)
  
  instance Show PointId where show (PointId x) = "point-" ++ show x
  instance Show RunId where show (RunId x) = "run-" ++ show x
  instance Show StateId where show (StateId x) = "state-" ++ show x
  instance Show PatchId where show (PatchId x) = "patch-" ++ show x
  
  instance Read RunId where readsPrec i s = [x | Just s <- [stripPrefix "run-" s], x <- readsPrec i s]
  
  newtype PatchIds = PatchIds String deriving (ToField, FromField, TypeField)
  
  patchIds :: [PatchId] -> PatchIds
  patchIds = PatchIds . concatMap (\(PatchId x) -> "[" ++ show x ++ "]")
  
  patchIdsSuperset :: [PatchId] -> PatchIds
  patchIdsSuperset = PatchIds . ('%':) . concatMap (\(PatchId x) -> "[" ++ show x ++ "]%")
  
  fromPatchIds :: PatchIds -> [PatchId]
  fromPatchIds (PatchIds "") = []
  fromPatchIds (PatchIds xs) = map (PatchId . readNote "fromPatchIds") $ splitOn "][" $ init $ tail xs
  
  
  #if OPALEYE
  data SATable a b c d e = SATable {saId_ :: a, saState_ :: b, saCreate_ :: c, saPoint_ :: d, saDuration_ :: e}
  type SATableVal = SATable StateId State UTCTime (Maybe PointId) (Maybe Seconds)
  type SATableCol = SATable (O.Column StateId) (O.Column State) (O.Column PGTimestamptz) (O.Column (Nullable Int)) (O.Column (Nullable PGFloat8))
  type SATableColW = SATable (Maybe (O.Column StateId)) (O.Column State) (O.Column PGTimestamptz) (O.Column (Nullable Int)) (O.Column (Nullable PGFloat8))
  
  $(makeAdaptorAndInstance "pSATable" ''SATable)
  
  saTable__ :: O.Table SATableColW SATableCol
  saTable__ = O.Table "state" $ pSATable $
      SATable (optional "rowid") (required "state") (required "time") (required "point") (required "duration")
  
  instance O.QueryRunnerColumnDefault Patch Patch where
      queryRunnerColumnDefault = O.fieldQueryRunnerColumn
  instance O.QueryRunnerColumnDefault State State where
      queryRunnerColumnDefault = O.fieldQueryRunnerColumn
  #endif
  
  
  saTable = table "state" saId saState (saState,saCreate,saPoint,saDuration)
  saId = rowid saTable :: Column StateId
  saState = column saTable "state" :: Column State
  saCreate = column saTable "time" :: Column UTCTime
  saPoint = column saTable "point" :: Column (Maybe PointId) -- both are Nothing for a setstate
  saDuration = column saTable "duration" :: Column (Maybe Seconds)
  
  
  #if OPALEYE
  data PCTable a b c d e f g h i j = PCTable {pcId_ :: a, pcPatch_ :: b, pcAuthor_ :: c, pcQueue_ :: d, pcStart_ :: e, pcDelete_ :: f, pcSupersede_ :: g, pcReject_ :: h, pcPlausible_ :: i, pcMerge_ :: j}
  type PCTableVal = PCTable PatchId Patch String UTCTime (Maybe UTCTime) (Maybe UTCTime) (Maybe UTCTime) (Maybe UTCTime) (Maybe UTCTime) (Maybe UTCTime)
  type PCTableColW = PCTable (Maybe (O.Column PatchId)) (O.Column Patch) (O.Column PGText) (O.Column PGTimestamptz) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz))
  type PCTableCol = PCTable (O.Column PatchId) (O.Column Patch) (O.Column PGText) (O.Column PGTimestamptz) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz)) (O.Column (Nullable PGTimestamptz))
  
  $(makeAdaptorAndInstance "pPCTable" ''PCTable)
  
  pcTable__ :: O.Table PCTableColW PCTableCol
  pcTable__ = O.Table "patch" $ pPCTable $
      PCTable (optional "rowid") (required "patch") (required "author") (required "queue") (required "start")
              (required "delete_") (required "supersede") (required "reject") (required "plausible") (required "merge")
  #endif
  
  
  pcTable = table "patch" pcId pcPatch (pcPatch, pcAuthor, pcQueue, pcStart, pcDelete, pcSupersede, pcReject, pcPlausible, pcMerge)
  pcId = rowid pcTable :: Column PatchId
  pcPatch = column pcTable "patch" :: Column Patch
  pcAuthor = column pcTable "author" :: Column String
  pcQueue = column pcTable "queue" :: Column UTCTime
  pcStart = column pcTable "start" :: Column (Maybe UTCTime)
  pcDelete = column pcTable "delete_" :: Column (Maybe UTCTime)
  pcSupersede = column pcTable "supersede" :: Column (Maybe UTCTime)
  pcReject = column pcTable "reject" :: Column (Maybe UTCTime)
  pcPlausible = column pcTable "plausible" :: Column (Maybe UTCTime)
  pcMerge = column pcTable "merge" :: Column (Maybe UTCTime)
  
  rjTable = table "reject" norowid () (rjPatch, rjTest, rjRun)
  rjPatch = column rjTable "patch" :: Column PatchId
  rjTest = column rjTable "test" :: Column (Maybe Test)
  rjRun = column rjTable "run" :: Column RunId
  
  ptTable = table "point" ptId (ptState, ptPatches) (ptState, ptPatches)
  ptId = rowid ptTable :: Column PointId
  ptState = column ptTable "state" :: Column StateId
  ptPatches = column ptTable "patches" :: Column PatchIds
  
  rnTable = table "run" rnId () (rnPoint, rnTest, rnSuccess, rnClient, rnStart, rnDuration)
  rnId = rowid rnTable :: Column RunId
  rnPoint = column rnTable "point" :: Column PointId
  rnTest = column rnTable "test" :: Column (Maybe Test)
  rnSuccess = column rnTable "success" :: Column Bool
  rnClient = column rnTable "client" :: Column Client
  rnStart = column rnTable "start" :: Column UTCTime
  rnDuration = column rnTable "duration" :: Column (Maybe Seconds) -- nothing for a skip
  
  tsTable = table "test" norowid () (tsPoint, tsTest)
  tsPoint = column tsTable "point" :: Column PointId
  tsTest = column tsTable "test" :: Column (Maybe Test)
  
  skTable = table "skip" norowid skTest (skTest, skComment)
  skTest = column skTable "test" :: Column Test
  skComment = column skTable "comment" :: Column String
  
  create :: Maybe FilePath -> IO Connection
  create file = do
      conn <- open $ fromMaybe ":memory:" file
      execute_ conn $ fromString "PRAGMA journal_mode = WAL;"
      execute_ conn $ fromString "PRAGMA synchronous = OFF;"
      sqlEnsureTable conn saTable
      sqlEnsureTable conn pcTable
      sqlEnsureTable conn rjTable
      sqlEnsureTable conn ptTable
      sqlEnsureTable conn rnTable
      sqlEnsureTable conn tsTable
      sqlEnsureTable conn skTable
      return conn
  
  save :: Connection -> FilePath -> IO ()
  save conn file = void $ bracket (open file) close $ \dest -> bracket
      (SQ.backupInit (connectionHandle dest) (fromString "main") (connectionHandle conn) (fromString "main"))
      SQ.backupFinish $
      \b -> SQ.backupStep b (-1)
  