ADD type for database configuration

app/Main.hs

@@ -88,7 +88,9 @@ sync = flag' Sync
   )
 
 parse :: Options -> IO ()
-parse (Options _ Reset)           = migrate_ nukeTables
+parse (Options c Reset)           = do
+  config <- readConfig c
+  migrate_ (sqlConfig config) nukeTables
 parse (Options c DumpAccounts)    = runDumpAccounts c
 parse (Options c DumpAccountKeys) = runDumpAccountKeys c
 parse (Options c DumpCurrencies)  = runDumpCurrencies c
@@ -141,7 +143,7 @@ runDumpAccountKeys c = do
 runSync :: FilePath -> IO ()
 runSync c = do
   config <- readConfig c
-  migrate_ $ do
+  migrate_ (sqlConfig config) $ do
     s <- getDBState config
     flip runReaderT (s $ takeDirectory c) $ do
       insertBudget $ budget config

lib/Internal/Config.hs

@@ -66,6 +66,7 @@ typeSubs = firstOrder ++ higherOrder
       , toVar (auto :: Decoder SplitNum)
       , toVar (auto :: Decoder MatchDesc)
       , toVar (auto :: Decoder MatchOther)
+      , toVar (auto :: Decoder SqlConfig)
       ]
 
 readYaml :: FromJSON a => FilePath -> IO a

lib/Internal/Database/Ops.hs

@@ -39,18 +39,20 @@ import           Internal.Database.Model
 import           Internal.Types
 import           Internal.Utils
 
-migrate_ :: SqlPersistT (ResourceT (NoLoggingT IO)) () -> IO ()
-migrate_ more = runNoLoggingT $ runResourceT
-          $ withSqlConn openConnection (\backend ->
-                                          flip runSqlConn backend $ do
-                                           runMigration migrateAll
-                                           more
+migrate_ :: SqlConfig -> SqlPersistT (ResourceT (NoLoggingT IO)) () -> IO ()
+migrate_ c more = runNoLoggingT $ runResourceT
+          $ withSqlConn (openConnection c) (\backend ->
+                                              flip runSqlConn backend $ do
+                                               runMigration migrateAll
+                                               more
                                        )
 
-openConnection :: LogFunc -> IO SqlBackend
-openConnection logfn = do
- conn <- open "/tmp/test.db"
- wrapConnection conn logfn
+openConnection :: SqlConfig -> LogFunc -> IO SqlBackend
+openConnection c logfn = case c of
+  Sqlite p -> do
+    conn <- open p
+    wrapConnection conn logfn
+  Postgres -> error "postgres not implemented"
 
 nukeTables :: MonadIO m => SqlPersistT m ()
 nukeTables = do

lib/Internal/Types.hs

@@ -34,6 +34,10 @@ import           Text.Read
 -- | YAML CONFIG
 -------------------------------------------------------------------------------
 
+data SqlConfig = Sqlite T.Text |
+  Postgres -- TODO
+  deriving (Generic, FromDhall)
+
 -------------------------------------------------------------------------------
 -- | account tree
 
@@ -86,6 +90,7 @@ data Config_ a = Config_
   , currencies :: ![Currency]
   , statements :: ![Statement]
   , accounts   :: a
+  , sqlConfig  :: !SqlConfig
   }
   deriving (Generic)