Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module provides types and functions for combining partial
configs into a complete configs to ultimately make a Plan
.
This module has three classes of types. Types like Lastoid
that
are generic and could live in a module like "base".
Types like PartialProcessConfig
that could be used by any
library that needs to combine process options.
Finally it has types and functions for creating Plan
s that
use temporary resources. This is used to create the default
behavior of startWith
and related
functions.
|
Synopsis
- data Lastoid a
- getLastoid :: Lastoid a -> a
- data PartialCommandLineArgs = PartialCommandLineArgs {}
- takeWhileInSequence :: [(Int, a)] -> [a]
- completeCommandLineArgs :: PartialCommandLineArgs -> [String]
- data PartialProcessConfig = PartialProcessConfig {}
- standardProcessConfig :: IO PartialProcessConfig
- addErrorContext :: String -> Either [String] a -> Either [String] a
- getOption :: String -> Last a -> Validation [String] a
- completeProcessConfig :: PartialProcessConfig -> Either [String] ProcessConfig
- data DirectoryType
- toFilePath :: DirectoryType -> FilePath
- data PartialDirectoryType
- initDirectoryType :: String -> PartialDirectoryType -> IO DirectoryType
- rmDirIgnoreErrors :: FilePath -> IO ()
- shutdownDirectoryType :: DirectoryType -> IO ()
- data SocketClass
- socketClassToConfig :: SocketClass -> [String]
- socketClassToHostFlag :: SocketClass -> [(String, Maybe String)]
- socketClassToHost :: SocketClass -> String
- data PartialSocketClass
- initPartialSocketClass :: PartialSocketClass -> IO SocketClass
- shutdownSocketConfig :: SocketClass -> IO ()
- data PartialPostgresPlan = PartialPostgresPlan {}
- completePostgresPlan :: PartialPostgresPlan -> Either [String] PostgresPlan
- data PartialPlan = PartialPlan {}
- completePlan :: PartialPlan -> Either [String] Plan
- data Resources = Resources {}
- data Config = Config {}
- toPlan :: Int -> SocketClass -> FilePath -> PartialPlan
- initConfig :: Config -> IO Resources
- shutdownResources :: Resources -> IO ()
- optionsToConfig :: Options -> Config
- optionsToPlan :: Options -> PartialPlan
- clientOptionsToPlan :: Options -> PartialPlan
- userToPlan :: String -> PartialPlan
- dbnameToPlan :: String -> PartialPlan
- hostToSocketClass :: String -> PartialSocketClass
Documentation
Lastoid
is helper for overriding configuration values.
It's Semigroup
instance let's one either combine the
a
of two Lastoid
s using <>
via the Mappend
constructor
or one can wholly replace the value with the last value using the Replace
constructor.
Roughly
x <> Replace y = Replace y Replace x <> Mappend y = Replace (x <> y) Mappend x <> Mappend y = Mappend (x <> y)
getLastoid :: Lastoid a -> a Source #
data PartialCommandLineArgs Source #
A type to help combine command line arguments.
PartialCommandLineArgs | |
|
Instances
takeWhileInSequence :: [(Int, a)] -> [a] Source #
Take values as long as the index is the successor of the last index.
completeCommandLineArgs :: PartialCommandLineArgs -> [String] Source #
This convert the PartialCommandLineArgs
to '
data PartialProcessConfig Source #
The monoidial version of ProcessConfig
. Used to combine overrides with
defaults when creating a ProcessConfig
.
PartialProcessConfig | |
|
Instances
standardProcessConfig :: IO PartialProcessConfig Source #
The standardProcessConfig
sets the handles to stdin
, stdout
and
stderr
and inherits the environment variables from the calling
process.
addErrorContext :: String -> Either [String] a -> Either [String] a Source #
A helper to add more info to all the error messages.
getOption :: String -> Last a -> Validation [String] a Source #
A helper for creating an error if a Last
is not defined.
completeProcessConfig :: PartialProcessConfig -> Either [String] ProcessConfig Source #
Turn a PartialProcessConfig
into a ProcessConfig
. Fails if
any values are missing.
data DirectoryType Source #
A type to track whether a file is temporary and needs to be cleaned up.
Instances
Eq DirectoryType Source # | |
Defined in Database.Postgres.Temp.Internal.Partial (==) :: DirectoryType -> DirectoryType -> Bool # (/=) :: DirectoryType -> DirectoryType -> Bool # | |
Ord DirectoryType Source # | |
Defined in Database.Postgres.Temp.Internal.Partial compare :: DirectoryType -> DirectoryType -> Ordering # (<) :: DirectoryType -> DirectoryType -> Bool # (<=) :: DirectoryType -> DirectoryType -> Bool # (>) :: DirectoryType -> DirectoryType -> Bool # (>=) :: DirectoryType -> DirectoryType -> Bool # max :: DirectoryType -> DirectoryType -> DirectoryType # min :: DirectoryType -> DirectoryType -> DirectoryType # | |
Show DirectoryType Source # | |
Defined in Database.Postgres.Temp.Internal.Partial showsPrec :: Int -> DirectoryType -> ShowS # show :: DirectoryType -> String # showList :: [DirectoryType] -> ShowS # |
toFilePath :: DirectoryType -> FilePath Source #
Get the file path of a DirectoryType
, regardless if it is a
Permanent
or Temporary
type.
data PartialDirectoryType Source #
The monoidial version of DirectoryType
. Used to combine overrides with
defaults when creating a DirectoryType
. The monoid instance treats
PTemporary
as mempty
and takes the last PPermanent
value.
PPermanent FilePath | A permanent file that should not be generated. |
PTemporary | A temporary file that needs to generated. |
Instances
rmDirIgnoreErrors :: FilePath -> IO () Source #
Either create a temporary directory or do nothing
shutdownDirectoryType :: DirectoryType -> IO () Source #
data SocketClass Source #
A type for configuring the listening address of the postgres
process.
postgres
can listen on several types of sockets simulatanously but we
don't support that behavior. One can either listen on a IP based socket
or a UNIX domain socket.
IpSocket String | IP socket type. The |
UnixSocket DirectoryType | UNIX domain socket |
Instances
socketClassToConfig :: SocketClass -> [String] Source #
Create the extra config lines for listening based on the SocketClass
socketClassToHostFlag :: SocketClass -> [(String, Maybe String)] Source #
Many processes require a "host" flag. We can generate one from the
SocketClass
.
socketClassToHost :: SocketClass -> String Source #
Get the IP address, host name or UNIX domain socket directory
as a String
data PartialSocketClass Source #
The monoidial version of SocketClass
. Used to combine overrides with
defaults when creating a SocketClass
. The monoid instance treats
'PUnixSocket mempty' as mempty
and combines the
PIpSocket (Last String) | The monoid for combining IP address configuration |
PUnixSocket PartialDirectoryType | The monoid for combining UNIX socket configuration |
Instances
initPartialSocketClass :: PartialSocketClass -> IO SocketClass Source #
Turn a PartialSocketClass
to a SocketClass
. If the PIpSocket
is
Nothing
default to "127.0.0.1". If the is a PUnixSocket
optionally create a temporary directory if configured to do so.
shutdownSocketConfig :: SocketClass -> IO () Source #
Cleanup the UNIX socket temporary directory if one was created.
data PartialPostgresPlan Source #
PartialPostgresPlan
PartialPostgresPlan | |
|
Instances
completePostgresPlan :: PartialPostgresPlan -> Either [String] PostgresPlan Source #
Turn a PartialPostgresPlan
into a PostgresPlan
. Fails if any
values are missing.
data PartialPlan Source #
The monoidial version of Plan
. Used to combine overrides with defaults
when creating a plan.
Instances
completePlan :: PartialPlan -> Either [String] Plan Source #
Turn a PartialPlan
into a Plan
. Fails if any values are missing.
Resources
holds a description of the temporary folders (if there are any)
and includes the final Plan
that can be used with initPlan
.
See initConfig
for an example of how to create a Resources
.
Resources | |
|
The high level options for overriding default behavior.
Config | |
|
Instances
Generic Config Source # | |
Semigroup Config Source # | |
Monoid Config Source # | |
type Rep Config Source # | |
Defined in Database.Postgres.Temp.Internal.Partial type Rep Config = D1 (MetaData "Config" "Database.Postgres.Temp.Internal.Partial" "tmp-postgres-1.2.0.1-6qHOmWmYlBT7m6KnUm0cRj" False) (C1 (MetaCons "Config" PrefixI True) ((S1 (MetaSel (Just "configPlan") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 PartialPlan) :*: S1 (MetaSel (Just "configSocket") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 PartialSocketClass)) :*: (S1 (MetaSel (Just "configDataDir") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 PartialDirectoryType) :*: S1 (MetaSel (Just "configPort") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 (Last (Maybe Int)))))) |
:: Int | port |
-> SocketClass | Whether to listen on a IP address or UNIX domain socket |
-> FilePath | The |
-> PartialPlan |
Create a PartialPlan
that sets the command line options of all processes
(initdb
, postgres
and createdb
) using a
Create all the temporary resources from a Config
. This also combines the
PartialPlan
from toPlan
with the extraConfig
passed in.
shutdownResources :: Resources -> IO () Source #
Free the temporary resources created by initConfig
optionsToConfig :: Options -> Config Source #
optionsToPlan :: Options -> PartialPlan Source #
Convert the Options
to a PartialPlan
that can
be connected to with the Options
.
clientOptionsToPlan :: Options -> PartialPlan Source #
Wrap the Options
in an appropiate
PartialPostgresPlan
userToPlan :: String -> PartialPlan Source #
Create a PartialPlan
given a user
dbnameToPlan :: String -> PartialPlan Source #
Adds a createdb
PartialProcessPlan with the argument
as the database name.
hostToSocketClass :: String -> PartialSocketClass Source #
Parse a host string as either an UNIX domain socket directory or a domain or IP.