Persist.hs

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell  #-}
-- |
-- Module      :  Web.Bot.Persist
-- Copyright   :  Alexander Krupenkin 2017
-- License     :  BSD3
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Bot storage utils.
--
module Web.Bot.Persist (
    Persist(..)
  , Connection(..)
  , ConnectInfo(..)
  , runDB
  , module Database.Persist
  ) where

import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Resource (ResourceT)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Logger (NoLoggingT)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import Data.Text (Text)

import Database.Persist.Postgresql (withPostgresqlConn,
                                    ConnectionString)
import Database.Persist.Sqlite (withSqliteConn)
import Database.Persist.MySQL (withMySQLConn,
                               ConnectInfo(..))
import Database.Persist.Sql (SqlBackend,
                             runSqlPersistM, runMigration)
import Database.Persist

import Web.Bot.Platform
import Web.Bot.Log

-- Models
import Web.Bot.Metrics
import Web.Bot.User

-- | Database connection information
data Connection = Postgresql ConnectionString
                | Sqlite Text
                | MySQL ConnectInfo
  deriving (Eq, Show)

-- | Connection info provider
class Platform a => Persist a where
    persist :: Bot a Connection

-- | Run some staff with database connection
runDB :: Persist a
      => ReaderT SqlBackend (NoLoggingT (ResourceT IO)) b
      -> Bot a b
runDB ma = do
    db <- persist
    $logDebugS "Persist" (T.append "Connection: " $ T.pack (show db))

    let runConnection = case db of
            Postgresql conn -> withPostgresqlConn conn
            Sqlite conn     -> withSqliteConn conn
            MySQL conn      -> withMySQLConn conn

    runConnection $ \backend ->
        liftIO $ flip runSqlPersistM backend $
            runMigration (migrateMetrics >> migrateUser) >> ma