SQL WIP

app/astro/Astro/SqlDB/CatalogueDB.hs

@@ -5,6 +5,7 @@ module Astro.SqlDB.CatalogueDB where
 import Hydra.Prelude
 
 import Database.Beam
+import           Data.Time.Clock (UTCTime)
 
 
 data MeteorT f = Meteor
@@ -15,7 +16,7 @@ data MeteorT f = Meteor
   , _altitude    :: Columnar f Int
   , _timestamp   :: Columnar f UTCTime
   }
-  deriving (Show, Eq, Ord, Generic, Beamable)
+  deriving (Generic, Beamable)
 
 type Meteor = MeteorT Identity
 type MeteorId = PrimaryKey MeteorT Identity

src/Hydra/Core/Interpreters.hs

@@ -10,3 +10,4 @@ import           Hydra.Core.Process.Interpreter     as X
 import           Hydra.Core.Random.Interpreter      as X
 import           Hydra.Core.State.Interpreter       as X
 import           Hydra.Core.KVDB.Interpreter        as X
+import           Hydra.Core.SqlDB.Interpreter       as X

src/Hydra/Core/Lang/Language.hs

@@ -15,6 +15,7 @@ import qualified Hydra.Core.Random.Language      as L
 import qualified Hydra.Core.State.Class          as L
 import qualified Hydra.Core.State.Language       as L
 import qualified Hydra.Core.KVDB.Language        as L
+import qualified Hydra.Core.SqlDB.Language       as L
 import qualified Hydra.Core.Lang.Class           as C
 import qualified Hydra.Core.Domain               as D
 

src/Hydra/Core/Language.hs

@@ -14,3 +14,4 @@ import           Hydra.Core.Random.Language      as X
 import           Hydra.Core.State.Class          as X
 import           Hydra.Core.State.Language       as X
 import           Hydra.Core.KVDB.Language        as X
+import           Hydra.Core.SqlDB.Language       as X

src/Hydra/Core/SqlDB/Interpreter.hs

@@ -17,7 +17,8 @@ import qualified Hydra.Core.Domain   as D
 
 
 interpretSqlDBF :: db -> L.SqlDBF a -> IO a
-interpretSqlDBF db (RawQuery rawQ next) = error "not implemented"
+-- interpretSqlDBF db (L.RawQuery rawQ next) = error "not implemented"
+interpretSqlDBF db (L.RunBeam _ next) = error "not implemented"
 
 runSqlDBL :: db -> L.SqlDBL a -> IO a
 runSqlDBL conn act = foldFree (interpretSqlDBF conn) act

src/Hydra/Core/SqlDB/Language.hs

@@ -12,14 +12,13 @@ import qualified Hydra.Core.Domain.SQLDB as D
 import           Language.Haskell.TH.MakeFunctor (makeFunctorInstance)
 
 import Database.Beam
-import Database.Beam.Sqlite
 
 data SqlDBF next where
   RunBeam :: String -> (D.DBResult a -> next) -> SqlDBF next
 
 makeFunctorInstance ''SqlDBF
 
-type SqlDBL db = Free SqlDBF
+type SqlDBL = Free SqlDBF
 
-rawQuery :: String -> SqlDBL (D.DBResult a)
-rawQuery rawQuery = liftF $ RawQuery rawQuery id
+-- rawQuery :: String -> SqlDBL (D.DBResult a)
+-- rawQuery rawQuery = liftF $ RawQuery rawQuery id

src/Hydra/Core/SqlDBRuntime.hs

@@ -28,14 +28,14 @@ initSQLiteDB' connsVar cfg@(D.SQLiteConfig dbName) = do
         putTMVar connsVar $ Map.insert dbName dbM conns
       pure $ Right $ D.SQLiteHandle D.SQLite dbName
 
-deInitSQLiteDB :: SQLiteDBConn -> IO ()
-deInitSQLiteDB connVar = do
+deInitSQLiteConn :: SQLiteDBConn -> IO ()
+deInitSQLiteConn connVar = do
   conn <- takeMVar connVar
-  void $ try $ SQLite.close conn
+  SQLite.close conn
   putMVar connVar conn
 
-closeSQLiteDBs :: SQLiteDBConns -> IO ()
-closeSQLiteDBs handleMapVar = do
+closeSQLiteConns :: SQLiteDBConns -> IO ()
+closeSQLiteConns handleMapVar = do
   handleMap <- atomically $ takeTMVar handleMapVar
-  mapM_ deInitSQLiteDB $ Map.elems handleMap
+  mapM_ deInitSQLiteConn $ Map.elems handleMap
   atomically $ putTMVar handleMapVar Map.empty