{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Refurb.Types
( ConnInfo(..)
, connInfoAsConnString, connInfoAsLogString
, MigrationType(..)
, MonadMigration
, Migration(..), migrationSchema, migrationKey, migrationType, migrationCheck, migrationExecute, migrationQualifiedKey
, schemaMigration, seedDataMigration, withCheck
) where
import ClassyPrelude
import Control.Lens.TH (makeLenses)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.ByteString.Char8 as BSC8
import Data.Word (Word16)
import qualified Database.PostgreSQL.Simple as PG
data ConnInfo = ConnInfo
{ ConnInfo -> Text
connHost :: Text
, ConnInfo -> Word16
connPort :: Word16
, ConnInfo -> Text
connUser :: Text
, ConnInfo -> Text
connPassword :: Text
, ConnInfo -> Text
connDbName :: Text
}
commonParams :: ConnInfo -> [(ByteString, ByteString)]
commonParams :: ConnInfo -> [(ByteString, ByteString)]
commonParams (ConnInfo {Word16
Text
connDbName :: Text
connPassword :: Text
connUser :: Text
connPort :: Word16
connHost :: Text
connDbName :: ConnInfo -> Text
connPassword :: ConnInfo -> Text
connUser :: ConnInfo -> Text
connPort :: ConnInfo -> Word16
connHost :: ConnInfo -> Text
..}) =
[ (ByteString
"host", Text -> ByteString
forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connHost)
, (ByteString
"port", Text -> ByteString
forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 (Text -> ByteString) -> (Word16 -> Text) -> Word16 -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word16 -> Text
forall a. Show a => a -> Text
tshow (Word16 -> ByteString) -> Word16 -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16
connPort)
, (ByteString
"user", Text -> ByteString
forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connUser)
, (ByteString
"dbname", Text -> ByteString
forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connDbName)
]
asConnString :: [(ByteString, ByteString)] -> ByteString
asConnString :: [(ByteString, ByteString)] -> ByteString
asConnString = ByteString -> [ByteString] -> ByteString
BSC8.intercalate ByteString
" " ([ByteString] -> ByteString)
-> ([(ByteString, ByteString)] -> [ByteString])
-> [(ByteString, ByteString)]
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\ (ByteString
key, ByteString
val) -> ByteString
key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
val)
connInfoAsConnString :: ConnInfo -> ByteString
connInfoAsConnString :: ConnInfo -> ByteString
connInfoAsConnString connInfo :: ConnInfo
connInfo@(ConnInfo { Text
connPassword :: Text
connPassword :: ConnInfo -> Text
connPassword }) =
[(ByteString, ByteString)] -> ByteString
asConnString ((ByteString
"password", Text -> ByteString
forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connPassword) (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: ConnInfo -> [(ByteString, ByteString)]
commonParams ConnInfo
connInfo)
connInfoAsLogString :: ConnInfo -> Text
connInfoAsLogString :: ConnInfo -> Text
connInfoAsLogString =
ByteString -> Text
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 (ByteString -> Text)
-> (ConnInfo -> ByteString) -> ConnInfo -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(ByteString, ByteString)] -> ByteString
asConnString ([(ByteString, ByteString)] -> ByteString)
-> (ConnInfo -> [(ByteString, ByteString)])
-> ConnInfo
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConnInfo -> [(ByteString, ByteString)]
commonParams
data MigrationType
= MigrationSchema
| MigrationSeedData
deriving (MigrationType -> MigrationType -> Bool
(MigrationType -> MigrationType -> Bool)
-> (MigrationType -> MigrationType -> Bool) -> Eq MigrationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationType -> MigrationType -> Bool
$c/= :: MigrationType -> MigrationType -> Bool
== :: MigrationType -> MigrationType -> Bool
$c== :: MigrationType -> MigrationType -> Bool
Eq, Int -> MigrationType -> ShowS
[MigrationType] -> ShowS
MigrationType -> String
(Int -> MigrationType -> ShowS)
-> (MigrationType -> String)
-> ([MigrationType] -> ShowS)
-> Show MigrationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationType] -> ShowS
$cshowList :: [MigrationType] -> ShowS
show :: MigrationType -> String
$cshow :: MigrationType -> String
showsPrec :: Int -> MigrationType -> ShowS
$cshowsPrec :: Int -> MigrationType -> ShowS
Show)
type MonadMigration m = (MonadBaseControl IO m, MonadMask m, MonadReader PG.Connection m, MonadLogger m)
data Migration = Migration
{ Migration -> Text
_migrationSchema :: Text
, Migration -> Text
_migrationKey :: Text
, Migration -> MigrationType
_migrationType :: MigrationType
, Migration -> forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck :: forall m. MonadMigration m => Maybe (m ())
, Migration -> forall (m :: * -> *). MonadMigration m => m ()
_migrationExecute :: forall m. MonadMigration m => m ()
}
migrationQualifiedKey :: Migration -> Text
migrationQualifiedKey :: Migration -> Text
migrationQualifiedKey (Migration { Text
_migrationSchema :: Text
_migrationSchema :: Migration -> Text
_migrationSchema, Text
_migrationKey :: Text
_migrationKey :: Migration -> Text
_migrationKey }) =
Text
_migrationSchema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
_migrationKey
makeLenses ''Migration
schemaMigration :: Text -> Text -> (forall m. MonadMigration m => m ()) -> Migration
schemaMigration :: Text
-> Text
-> (forall (m :: * -> *). MonadMigration m => m ())
-> Migration
schemaMigration Text
schema Text
key forall (m :: * -> *). MonadMigration m => m ()
execute = Migration :: Text
-> Text
-> MigrationType
-> (forall (m :: * -> *). MonadMigration m => Maybe (m ()))
-> (forall (m :: * -> *). MonadMigration m => m ())
-> Migration
Migration
{ _migrationSchema :: Text
_migrationSchema = Text
schema
, _migrationKey :: Text
_migrationKey = Text
key
, _migrationType :: MigrationType
_migrationType = MigrationType
MigrationSchema
, _migrationCheck :: forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck = forall a. Maybe a
forall (m :: * -> *). MonadMigration m => Maybe (m ())
Nothing
, _migrationExecute :: forall (m :: * -> *). MonadMigration m => m ()
_migrationExecute = forall (m :: * -> *). MonadMigration m => m ()
execute
}
seedDataMigration :: Text -> Text -> (forall m. MonadMigration m => m ()) -> Migration
seedDataMigration :: Text
-> Text
-> (forall (m :: * -> *). MonadMigration m => m ())
-> Migration
seedDataMigration Text
schema Text
key forall (m :: * -> *). MonadMigration m => m ()
execute = Migration :: Text
-> Text
-> MigrationType
-> (forall (m :: * -> *). MonadMigration m => Maybe (m ()))
-> (forall (m :: * -> *). MonadMigration m => m ())
-> Migration
Migration
{ _migrationSchema :: Text
_migrationSchema = Text
schema
, _migrationKey :: Text
_migrationKey = Text
key
, _migrationType :: MigrationType
_migrationType = MigrationType
MigrationSeedData
, _migrationCheck :: forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck = forall a. Maybe a
forall (m :: * -> *). MonadMigration m => Maybe (m ())
Nothing
, _migrationExecute :: forall (m :: * -> *). MonadMigration m => m ()
_migrationExecute = forall (m :: * -> *). MonadMigration m => m ()
execute
}
withCheck :: Migration -> (forall m. MonadMigration m => m ()) -> Migration
withCheck :: Migration
-> (forall (m :: * -> *). MonadMigration m => m ()) -> Migration
withCheck Migration
m forall (m :: * -> *). MonadMigration m => m ()
c = Migration
m { _migrationCheck :: forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck = m () -> Maybe (m ())
forall a. a -> Maybe a
Just m ()
forall (m :: * -> *). MonadMigration m => m ()
c }