{-# 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", forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connHost)
, (ByteString
"port", forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ Word16
connPort)
, (ByteString
"user", forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connUser)
, (ByteString
"dbname", 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
" " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\ (ByteString
key, ByteString
val) -> ByteString
key forall a. Semigroup a => a -> a -> a
<> 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", forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connPassword) forall a. a -> [a] -> [a]
: ConnInfo -> [(ByteString, ByteString)]
commonParams ConnInfo
connInfo)
connInfoAsLogString :: ConnInfo -> Text
connInfoAsLogString :: ConnInfo -> Text
connInfoAsLogString =
forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 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 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
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
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 forall a. Semigroup a => a -> a -> a
<> 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
{ _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
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
{ _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
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 = forall a. a -> Maybe a
Just forall (m :: * -> *). MonadMigration m => m ()
c }