{-# OPTIONS_HADDOCK prune #-}
module Database.Postgres.Temp.Internal.Config where
import Database.Postgres.Temp.Internal.Core
import Control.Applicative.Lift
import Control.DeepSeq
import Control.Exception
import Control.Monad (join)
import Crypto.Hash.SHA1 (hash)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Base64.URL as Base64
import Data.Char
import qualified Data.Map.Strict as Map
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Monoid
import Data.Monoid.Generic
import Data.List
import qualified Database.PostgreSQL.Simple.Options as Client
import GHC.Generics (Generic)
import Network.Socket.Free (getFreePort)
import System.Directory
import System.Environment
import System.Exit (ExitCode(..))
import System.IO
import System.IO.Error
import System.IO.Temp (createTempDirectory)
import System.IO.Unsafe (unsafePerformIO)
import System.Process
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
data Accum a = DontCare | Zlich | Merge a
deriving stock (Show, Eq, Ord, Functor)
instance Applicative Accum where
pure = Merge
af <*> ax = case (af, ax) of
(Merge f, Merge x) -> Merge $ f x
(DontCare, _) -> DontCare
(_, DontCare) -> DontCare
(Zlich, _) -> Zlich
(_, Zlich) -> Zlich
instance Semigroup a => Semigroup (Accum a) where
x <> y = case (x, y) of
(DontCare, b) -> b
(a , DontCare ) -> a
(Zlich , _ ) -> Zlich
(_ , Zlich) -> Zlich
(Merge a, Merge b) -> Merge $ a <> b
getAccum :: Accum a -> Maybe a
getAccum = \case
Merge a -> Just a
_ -> Nothing
instance Monoid a => Monoid (Accum a) where
mempty = DontCare
prettyMap :: (Pretty a, Pretty b) => Map a b -> Doc
prettyMap theMap =
let xs = Map.toList theMap
in vsep $ map (uncurry prettyKeyPair) xs
data EnvironmentVariables = EnvironmentVariables
{ inherit :: Last Bool
, specific :: Map String String
}
deriving stock (Generic, Show, Eq)
instance Semigroup EnvironmentVariables where
x <> y = EnvironmentVariables
{ inherit =
inherit x <> inherit y
, specific =
specific y <> specific x
}
instance Monoid EnvironmentVariables where
mempty = EnvironmentVariables mempty mempty
instance Pretty EnvironmentVariables where
pretty EnvironmentVariables {..}
= text "inherit:"
<+> pretty (getLast inherit)
<> hardline
<> text "specific:"
<> softline
<> indent 2 (prettyMap specific)
completeEnvironmentVariables
:: [(String, String)]
-> EnvironmentVariables
-> Either [String] [(String, String)]
completeEnvironmentVariables envs EnvironmentVariables {..} = case getLast inherit of
Nothing -> Left ["Inherit not specified"]
Just x -> Right $ (if x then envs else [])
<> Map.toList specific
data CommandLineArgs = CommandLineArgs
{ keyBased :: Map String (Maybe String)
, indexBased :: Map Int String
}
deriving stock (Generic, Show, Eq)
deriving Monoid via GenericMonoid CommandLineArgs
instance Semigroup CommandLineArgs where
x <> y = CommandLineArgs
{ keyBased =
keyBased y <> keyBased x
, indexBased =
indexBased y <> indexBased x
}
instance Pretty CommandLineArgs where
pretty p@CommandLineArgs {..}
= text "keyBased:"
<> softline
<> indent 2 (prettyMap keyBased)
<> hardline
<> text "indexBased:"
<> softline
<> indent 2 (prettyMap indexBased)
<> hardline
<> text "completed:" <+> text (unwords (completeCommandLineArgs p))
takeWhileInSequence :: [(Int, a)] -> [a]
takeWhileInSequence ((0, x):xs) = x : go 0 xs where
go _ [] = []
go prev ((next, a):rest)
| prev + 1 == next = a : go next rest
| otherwise = []
takeWhileInSequence _ = []
completeCommandLineArgs :: CommandLineArgs -> [String]
completeCommandLineArgs CommandLineArgs {..}
= map (\(name, mvalue) -> maybe name (name <>) mvalue)
(Map.toList keyBased)
<> takeWhileInSequence (Map.toList indexBased)
data ProcessConfig = ProcessConfig
{ environmentVariables :: EnvironmentVariables
, commandLine :: CommandLineArgs
, stdIn :: Last Handle
, stdOut :: Last Handle
, stdErr :: Last Handle
}
deriving stock (Generic, Eq, Show)
deriving Semigroup via GenericSemigroup ProcessConfig
deriving Monoid via GenericMonoid ProcessConfig
instance Pretty ProcessConfig where
pretty ProcessConfig {..}
= text "environmentVariables:"
<> softline
<> indent 2 (pretty environmentVariables)
<> hardline
<> text "commandLine:"
<> softline
<> indent 2 (pretty environmentVariables)
<> hardline
<> text "stdIn:" <+>
pretty (prettyHandle <$> getLast stdIn)
<> hardline
<> text "stdOut:" <+>
pretty (prettyHandle <$> getLast stdOut)
<> hardline
<> text "stdErr:" <+>
pretty (prettyHandle <$> getLast stdErr)
standardProcessConfig :: ProcessConfig
standardProcessConfig = mempty
{ environmentVariables = mempty
{ inherit = pure True
}
, stdIn = pure stdin
, stdOut = pure stdout
, stdErr = pure stderr
}
devNull :: Handle
devNull = unsafePerformIO (openFile "/dev/null" WriteMode)
{-# NOINLINE devNull #-}
silentProcessConfig :: ProcessConfig
silentProcessConfig = mempty
{ environmentVariables = mempty
{ inherit = pure True
}
, stdIn = pure devNull
, stdOut = pure devNull
, stdErr = pure devNull
}
addErrorContext :: String -> Either [String] a -> Either [String] a
addErrorContext cxt = either (Left . map (cxt <>)) Right
getOption :: String -> Last a -> Errors [String] a
getOption optionName = \case
Last (Just x) -> pure x
Last Nothing -> failure ["Missing " ++ optionName ++ " option"]
completeProcessConfig
:: [(String, String)] -> ProcessConfig -> Either [String] CompleteProcessConfig
completeProcessConfig envs ProcessConfig {..} = runErrors $ do
let completeProcessConfigCmdLine = completeCommandLineArgs commandLine
completeProcessConfigEnvVars <- eitherToErrors $
completeEnvironmentVariables envs environmentVariables
completeProcessConfigStdIn <-
getOption "stdIn" stdIn
completeProcessConfigStdOut <-
getOption "stdOut" stdOut
completeProcessConfigStdErr <-
getOption "stdErr" stdErr
pure CompleteProcessConfig {..}
data CompleteDirectoryType = CPermanent FilePath | CTemporary FilePath
deriving stock (Show, Eq, Ord, Generic)
deriving anyclass (NFData)
toFilePath :: CompleteDirectoryType -> FilePath
toFilePath = \case
CPermanent x -> x
CTemporary x -> x
instance Pretty CompleteDirectoryType where
pretty = \case
CPermanent x -> text "CPermanent" <+> pretty x
CTemporary x -> text "CTemporary" <+> pretty x
makePermanent :: CompleteDirectoryType -> CompleteDirectoryType
makePermanent = \case
CTemporary x -> CPermanent x
x -> x
data DirectoryType
= Permanent FilePath
| Temporary
deriving(Show, Eq, Ord)
instance Pretty DirectoryType where
pretty = \case
Permanent x -> text "Permanent" <+> pretty x
Temporary -> text "Temporary"
instance Semigroup DirectoryType where
x <> y = case (x, y) of
(a, Temporary ) -> a
(_, a@Permanent {}) -> a
instance Monoid DirectoryType where
mempty = Temporary
setupDirectoryType
:: String
-> String
-> DirectoryType
-> IO CompleteDirectoryType
setupDirectoryType tempDir pat = \case
Temporary -> CTemporary <$> createTempDirectory tempDir pat
Permanent x -> CPermanent <$> case x of
'~':rest -> do
homeDir <- getHomeDirectory
pure $ homeDir <> "/" <> rest
xs -> pure xs
rmDirIgnoreErrors :: FilePath -> IO ()
rmDirIgnoreErrors mainDir = do
let ignoreDirIsMissing e
| isDoesNotExistError e = return ()
| otherwise = throwIO e
let newName = mainDir <> "_removing"
handle ignoreDirIsMissing $ uninterruptibleMask_ $ do
renameDirectory mainDir newName
removeDirectoryRecursive newName
cleanupDirectoryType :: CompleteDirectoryType -> IO ()
cleanupDirectoryType = \case
CPermanent _ -> pure ()
CTemporary filePath -> rmDirIgnoreErrors filePath
data PostgresPlan = PostgresPlan
{ postgresConfig :: ProcessConfig
, connectionOptions :: Client.Options
}
deriving stock (Generic)
deriving Semigroup via GenericSemigroup PostgresPlan
deriving Monoid via GenericMonoid PostgresPlan
instance Pretty PostgresPlan where
pretty PostgresPlan {..}
= text "postgresConfig:"
<> softline
<> indent 2 (pretty postgresConfig)
<> hardline
<> text "connectionOptions:"
<> softline
<> indent 2 (prettyOptions connectionOptions)
completePostgresPlan :: [(String, String)] -> PostgresPlan -> Either [String] CompletePostgresPlan
completePostgresPlan envs PostgresPlan {..} = runErrors $ do
let completePostgresPlanClientOptions = connectionOptions
completePostgresPlanProcessConfig <-
eitherToErrors $ addErrorContext "postgresConfig: " $
completeProcessConfig envs postgresConfig
pure CompletePostgresPlan {..}
data Plan = Plan
{ logger :: Last Logger
, initDbConfig :: Accum ProcessConfig
, copyConfig :: Last (Maybe CopyDirectoryCommand)
, createDbConfig :: Accum ProcessConfig
, postgresPlan :: PostgresPlan
, postgresConfigFile :: [String]
, dataDirectoryString :: Last String
, connectionTimeout :: Last Int
}
deriving stock (Generic)
deriving Semigroup via GenericSemigroup Plan
deriving Monoid via GenericMonoid Plan
instance Pretty Plan where
pretty Plan {..}
= text "initDbConfig:"
<> softline
<> indent 2 (pretty $ getAccum initDbConfig)
<> hardline
<> text "initDbConfig:"
<> softline
<> indent 2 (pretty $ getAccum createDbConfig)
<> text "copyConfig:"
<> softline
<> indent 2 (pretty (getLast copyConfig))
<> hardline
<> text "postgresPlan:"
<> softline
<> indent 2 (pretty postgresPlan)
<> hardline
<> text "postgresConfigFile:"
<> softline
<> indent 2 (vsep $ map text postgresConfigFile)
<> hardline
<> text "dataDirectoryString:" <+> pretty (getLast dataDirectoryString)
<> hardline
<> text "connectionTimeout:" <+> pretty (getLast connectionTimeout)
completePlan :: [(String, String)] -> Plan -> Either [String] CompletePlan
completePlan envs Plan {..} = do
( completePlanLogger
, completePlanInitDb
, completePlanCreateDb
, completePlanPostgres
, completePlanDataDirectory
, completePlanConnectionTimeout
) <- runErrors
$ (,,,,,)
<$> getOption "logger" logger
<*> eitherToErrors (addErrorContext "initDbConfig: " $
traverse (completeProcessConfig envs) $ getAccum initDbConfig)
<*> eitherToErrors (addErrorContext "createDbConfig: " $
traverse (completeProcessConfig envs) $ getAccum createDbConfig)
<*> eitherToErrors (addErrorContext "postgresPlan: "
(completePostgresPlan envs postgresPlan))
<*> getOption "dataDirectoryString" dataDirectoryString
<*> getOption "connectionTimeout" connectionTimeout
let completePlanConfig = unlines postgresConfigFile
completePlanCopy = completeCopyDirectory completePlanDataDirectory <$>
join (getLast copyConfig)
pure CompletePlan {..}
hasInitDb :: Plan -> Bool
hasInitDb Plan {..} = isJust $ getAccum initDbConfig
hasCreateDb :: Plan -> Bool
hasCreateDb Plan {..} = isJust $ getAccum createDbConfig
data Config = Config
{ plan :: Plan
, socketDirectory :: DirectoryType
, dataDirectory :: DirectoryType
, port :: Last (Maybe Int)
, temporaryDirectory :: Last FilePath
, initDbCache :: Last (Maybe (Bool, FilePath))
}
deriving stock (Generic)
deriving Semigroup via GenericSemigroup Config
deriving Monoid via GenericMonoid Config
instance Pretty Config where
pretty Config {..}
= text "plan:"
<> softline
<> pretty plan
<> hardline
<> text "socketDirectory:"
<> softline
<> pretty socketDirectory
<> hardline
<> text "dataDirectory:"
<> softline
<> pretty dataDirectory
<> hardline
<> text "port:" <+> pretty (getLast port)
<> hardline
<> text "temporaryDirectory:"
<> softline
<> pretty (getLast temporaryDirectory)
<> hardline
<> text "initDbCache:" <+> pretty (getLast initDbCache)
socketDirectoryToConfig :: FilePath -> [String]
socketDirectoryToConfig dir =
[ "listen_addresses = '127.0.0.1,::1'"
, "unix_socket_directories = '" <> dir <> "'"
]
data CopyDirectoryCommand = CopyDirectoryCommand
{ sourceDirectory :: FilePath
, destinationDirectory :: Maybe FilePath
, useCopyOnWrite :: Bool
} deriving (Show, Eq, Ord)
instance Pretty CopyDirectoryCommand where
pretty CopyDirectoryCommand {..}
= text "sourceDirectory:"
<> softline
<> indent 2 (text sourceDirectory)
<> hardline
<> text "destinationDirectory:"
<> softline
<> indent 2 (pretty destinationDirectory)
<> hardline
<> text "useCopyOnWrite:"
<+> pretty useCopyOnWrite
completeCopyDirectory
:: FilePath
-> CopyDirectoryCommand
-> CompleteCopyDirectoryCommand
completeCopyDirectory theDataDirectory CopyDirectoryCommand {..} =
CompleteCopyDirectoryCommand
{ copyDirectoryCommandSrc = sourceDirectory
, copyDirectoryCommandDst = fromMaybe theDataDirectory destinationDirectory
, copyDirectoryCommandCow = useCopyOnWrite
}
getInitDbVersion :: String
getInitDbVersion = unsafePerformIO $ readProcessWithExitCode "initdb" ["--version"] "" >>= \case
(ExitSuccess, outputString, _) -> do
let
theLastPart = last $ words outputString
versionPart = takeWhile (\x -> isDigit x || x == '.' || x == '-') theLastPart
humanReadable = if last versionPart == '.'
then init versionPart
else versionPart
pure $ humanReadable <> take 8 (makeArgumentHash outputString)
(startErrorExitCode, startErrorStdOut, startErrorStdErr) ->
throwIO InitDbFailed {..}
{-# NOINLINE getInitDbVersion #-}
makeCommandLine :: String -> CompleteProcessConfig -> String
makeCommandLine command CompleteProcessConfig {..} =
let envs = unwords $ map (\(x, y) -> x <> "=" <> y) completeProcessConfigEnvVars
args = unwords completeProcessConfigCmdLine
in envs <> " " <> command <> args
makeInitDbCommandLine :: CompleteProcessConfig -> String
makeInitDbCommandLine = makeCommandLine "initdb"
makeArgumentHash :: String -> String
makeArgumentHash = BSC.unpack . Base64.encode . hash . BSC.pack
makeCachePath :: FilePath -> String -> String
makeCachePath cacheFolder cmdLine =
let
version = getInitDbVersion
theHash = makeArgumentHash cmdLine
in cacheFolder <> "/" <> version <> "/" <> theHash
splitDataDirectory :: CompleteProcessConfig -> (Maybe String, CompleteProcessConfig)
splitDataDirectory old =
let isDataDirectoryFlag xs = "-D" `isPrefixOf` xs || "--pgdata=" `isPrefixOf` xs
(dataDirectoryArgs, otherArgs) =
partition isDataDirectoryFlag $ completeProcessConfigCmdLine old
firstDataDirectoryArg = flip fmap (listToMaybe dataDirectoryArgs) $ \case
'-':'D':' ':theDir -> theDir
'-':'D':theDir -> theDir
'-':'-':'p':'g':'d':'a':'t':'a':'=':theDir -> theDir
_ -> error "splitDataDirectory not possible"
filteredEnvs = filter (("PGDATA" /=) . fst) $
completeProcessConfigEnvVars old
clearedConfig = old
{ completeProcessConfigCmdLine = otherArgs
, completeProcessConfigEnvVars = filteredEnvs
}
in (firstDataDirectoryArg, clearedConfig)
addDataDirectory :: String -> CompleteProcessConfig -> CompleteProcessConfig
addDataDirectory theDataDirectory x = x
{ completeProcessConfigCmdLine =
("--pgdata=" <> theDataDirectory) : completeProcessConfigCmdLine x
}
cachePlan :: CompletePlan -> Bool -> FilePath -> IO CompletePlan
cachePlan plan@CompletePlan {..} cow cacheDirectory = case completePlanInitDb of
Nothing -> pure plan
Just theConfig -> do
let (mtheDataDirectory, clearedConfig) = splitDataDirectory theConfig
theDataDirectory <- maybe
(throwIO $ FailedToFindDataDirectory (show $ pretty clearedConfig))
pure
mtheDataDirectory
let
theCommandLine = makeInitDbCommandLine clearedConfig
cachePath = makeCachePath cacheDirectory theCommandLine
cachedDataDirectory = cachePath <> "/data"
theInitDbPlan <- doesDirectoryExist cachePath >>= \case
True -> pure Nothing
False -> do
createDirectoryIfMissing True cachePath
writeFile (cachePath <> "/commandLine.log") theCommandLine
pure $ pure $ addDataDirectory cachedDataDirectory clearedConfig
pure plan
{ completePlanCopy = pure $ CompleteCopyDirectoryCommand
{ copyDirectoryCommandSrc = cachedDataDirectory
, copyDirectoryCommandDst = theDataDirectory
, copyDirectoryCommandCow = cow
}
, completePlanInitDb = theInitDbPlan
}
toPlan
:: Bool
-> Bool
-> Int
-> FilePath
-> FilePath
-> Plan
toPlan _makeInitDb makeCreateDb port socketDirectory dataDirectoryString = mempty
{ postgresConfigFile = socketDirectoryToConfig socketDirectory
, dataDirectoryString = pure dataDirectoryString
, connectionTimeout = pure (60 * 1000000)
, logger = pure $ const $ pure ()
, postgresPlan = mempty
{ postgresConfig = silentProcessConfig
{ commandLine = mempty
{ keyBased = Map.fromList
[ ("-p", Just $ show port)
, ("-D", Just dataDirectoryString)
]
}
}
, connectionOptions = mempty
{ Client.host = pure socketDirectory
, Client.port = pure port
, Client.dbname = pure "postgres"
}
}
, createDbConfig = if makeCreateDb
then pure silentProcessConfig
{ commandLine = mempty
{ keyBased = Map.fromList
[ ("-h", Just socketDirectory)
, ("-p ", Just $ show port)
]
}
}
else mempty
, initDbConfig = pure silentProcessConfig
{ commandLine = mempty
{ keyBased = Map.fromList
[("--pgdata=", Just dataDirectoryString)]
}
}
, copyConfig = pure Nothing
}
setupConfig
:: Config
-> IO Resources
setupConfig Config {..} = evalContT $ do
envs <- lift getEnvironment
thePort <- lift $ maybe getFreePort pure $ join $ getLast port
let resourcesTemporaryDir = fromMaybe "/tmp" $ getLast temporaryDirectory
resourcesInitDbCache = join $ getLast initDbCache
resourcesSocketDirectory <- ContT $ bracketOnError
(setupDirectoryType resourcesTemporaryDir "tmp-postgres-socket" socketDirectory) cleanupDirectoryType
resourcesDataDir <- ContT $ bracketOnError
(setupDirectoryType resourcesTemporaryDir "tmp-postgres-data" dataDirectory) cleanupDirectoryType
let hostAndDir = toPlan
(hasInitDb plan)
(hasCreateDb plan)
thePort
(toFilePath resourcesSocketDirectory)
(toFilePath resourcesDataDir)
finalPlan = hostAndDir <> plan
uncachedPlan <- lift $
either (throwIO . CompletePlanFailed (show $ pretty finalPlan)) pure $
completePlan envs finalPlan
resourcesPlan <- lift $ maybe (pure uncachedPlan) (uncurry $ cachePlan uncachedPlan) resourcesInitDbCache
pure Resources {..}
cleanupConfig :: Resources -> IO ()
cleanupConfig Resources {..} = do
cleanupDirectoryType resourcesSocketDirectory
cleanupDirectoryType resourcesDataDir
prettyPrintConfig :: Config -> String
prettyPrintConfig = show . pretty
data Resources = Resources
{ resourcesPlan :: CompletePlan
, resourcesSocketDirectory :: CompleteDirectoryType
, resourcesDataDir :: CompleteDirectoryType
, resourcesTemporaryDir :: FilePath
, resourcesInitDbCache :: Maybe (Bool, FilePath)
}
instance Pretty Resources where
pretty Resources {..}
= text "resourcePlan:"
<> softline
<> indent 2 (pretty resourcesPlan)
<> hardline
<> text "resourcesSocket:"
<+> pretty resourcesSocketDirectory
<> hardline
<> text "resourcesDataDir:"
<+> pretty resourcesDataDir
makeResourcesDataDirPermanent :: Resources -> Resources
makeResourcesDataDirPermanent r = r
{ resourcesDataDir = makePermanent $ resourcesDataDir r
}
optionsToConfig :: Client.Options -> Config
optionsToConfig opts@Client.Options {..}
= ( mempty
{ plan = optionsToPlan opts
, port = maybe (Last Nothing) (pure . pure) $ getLast port
, socketDirectory = maybe mempty hostToSocketClass $ getLast host
}
)
optionsToPlan :: Client.Options -> Plan
optionsToPlan opts@Client.Options {..}
= maybe mempty (dbnameToPlan (getLast user) (getLast password)) (getLast dbname)
<> maybe mempty userToPlan (getLast user)
<> maybe mempty passwordToPlan (getLast password)
<> clientOptionsToPlan opts
clientOptionsToPlan :: Client.Options -> Plan
clientOptionsToPlan opts = mempty
{ postgresPlan = mempty
{ connectionOptions = opts
}
}
userToPlan :: String -> Plan
userToPlan user = mempty
{ initDbConfig = pure mempty
{ commandLine = mempty
{ keyBased = Map.singleton "--username=" $ Just user
}
}
}
dbnameToPlan :: Maybe String -> Maybe String -> String -> Plan
dbnameToPlan muser mpassword dbName
| dbName == "template1" || dbName == "postgres" = mempty
| otherwise = mempty
{ createDbConfig = pure mempty
{ commandLine = mempty
{ indexBased = Map.singleton 0 dbName
, keyBased = maybe mempty (Map.singleton "--username=" . Just) muser
}
, environmentVariables = mempty
{ specific = maybe mempty (Map.singleton "PGPASSWORD") mpassword
}
}
}
passwordToPlan :: String -> Plan
passwordToPlan password = mempty
{ initDbConfig = pure mempty
{ environmentVariables = mempty
{ specific = Map.singleton "PGPASSWORD" password
}
}
}
hostToSocketClass :: String -> DirectoryType
hostToSocketClass hostOrSocketPath = case hostOrSocketPath of
'/' : _ -> Permanent hostOrSocketPath
_ -> Temporary
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
type Lens' s a = Lens s s a a
inheritL :: Lens' EnvironmentVariables (Last Bool)
inheritL f_aj5e (EnvironmentVariables x_aj5f x_aj5g)
= fmap (`EnvironmentVariables` x_aj5g)
(f_aj5e x_aj5f)
{-# INLINE inheritL #-}
specificL :: Lens' EnvironmentVariables (Map String String)
specificL f_aj5i (EnvironmentVariables x_aj5j x_aj5k)
= fmap (EnvironmentVariables x_aj5j)
(f_aj5i x_aj5k)
{-# INLINE specificL #-}
commandLineL ::
Lens' ProcessConfig CommandLineArgs
commandLineL
f_allv
(ProcessConfig x_allw x_allx x_ally x_allz x_allA)
= fmap
(\ y_allB
-> ProcessConfig x_allw y_allB x_ally x_allz
x_allA)
(f_allv x_allx)
{-# INLINE commandLineL #-}
environmentVariablesL ::
Lens' ProcessConfig EnvironmentVariables
environmentVariablesL
f_allC
(ProcessConfig x_allD x_allE x_allF x_allG x_allH)
= fmap
(\ y_allI
-> ProcessConfig y_allI x_allE x_allF x_allG
x_allH)
(f_allC x_allD)
{-# INLINE environmentVariablesL #-}
stdErrL ::
Lens' ProcessConfig (Last Handle)
stdErrL
f_allJ
(ProcessConfig x_allK x_allL x_allM x_allN x_allO)
= fmap
(ProcessConfig x_allK x_allL x_allM x_allN)
(f_allJ x_allO)
{-# INLINE stdErrL #-}
stdInL ::
Lens' ProcessConfig (Last Handle)
stdInL
f_allQ
(ProcessConfig x_allR x_allS x_allT x_allU x_allV)
= fmap
(\ y_allW
-> ProcessConfig x_allR x_allS y_allW x_allU
x_allV)
(f_allQ x_allT)
{-# INLINE stdInL #-}
stdOutL ::
Lens' ProcessConfig (Last Handle)
stdOutL
f_allX
(ProcessConfig x_allY x_allZ x_alm0 x_alm1 x_alm2)
= fmap
(\ y_alm3
-> ProcessConfig x_allY x_allZ x_alm0 y_alm3
x_alm2)
(f_allX x_alm1)
{-# INLINE stdOutL #-}
connectionOptionsL ::
Lens' PostgresPlan Client.Options
connectionOptionsL
f_am1y
(PostgresPlan x_am1z x_am1A)
= fmap (PostgresPlan x_am1z)
(f_am1y x_am1A)
{-# INLINE connectionOptionsL #-}
postgresConfigL ::
Lens' PostgresPlan ProcessConfig
postgresConfigL
f_am1C
(PostgresPlan x_am1D x_am1E)
= fmap (`PostgresPlan` x_am1E)
(f_am1C x_am1D)
{-# INLINE postgresConfigL #-}
postgresConfigFileL :: Lens' Plan [String]
postgresConfigFileL f plan@Plan{..}
= fmap (\x -> plan { postgresConfigFile = x })
(f postgresConfigFile)
{-# INLINE postgresConfigFileL #-}
createDbConfigL ::
Lens' Plan (Accum ProcessConfig)
createDbConfigL f plan@Plan{..}
= fmap (\x -> plan { createDbConfig = x })
(f createDbConfig)
{-# INLINE createDbConfigL #-}
dataDirectoryStringL :: Lens' Plan (Last String)
dataDirectoryStringL f plan@Plan{..}
= fmap (\x -> plan { dataDirectoryString = x })
(f dataDirectoryString)
{-# INLINE dataDirectoryStringL #-}
copyConfigL :: Lens' Plan (Last (Maybe CopyDirectoryCommand))
copyConfigL f plan@Plan{..}
= fmap (\x -> plan { copyConfig = x })
(f copyConfig)
{-# INLINE copyConfigL #-}
initDbConfigL :: Lens' Plan (Accum ProcessConfig)
initDbConfigL f plan@Plan{..}
= fmap (\x -> plan { initDbConfig = x })
(f initDbConfig)
{-# INLINE initDbConfigL #-}
loggerL :: Lens' Plan (Last Logger)
loggerL f plan@Plan{..}
= fmap (\x -> plan { logger = x })
(f logger)
{-# INLINE loggerL #-}
postgresPlanL :: Lens' Plan PostgresPlan
postgresPlanL f plan@Plan{..}
= fmap (\x -> plan { postgresPlan = x })
(f postgresPlan)
{-# INLINE postgresPlanL #-}
connectionTimeoutL :: Lens' Plan (Last Int)
connectionTimeoutL f plan@Plan{..}
= fmap (\x -> plan { connectionTimeout = x })
(f connectionTimeout)
{-# INLINE connectionTimeoutL #-}
resourcesDataDirL :: Lens' Resources CompleteDirectoryType
resourcesDataDirL f resources@Resources {..}
= fmap (\x -> resources { resourcesDataDir = x })
(f resourcesDataDir)
{-# INLINE resourcesDataDirL #-}
resourcesPlanL :: Lens' Resources CompletePlan
resourcesPlanL f resources@Resources {..}
= fmap (\x -> resources { resourcesPlan = x })
(f resourcesPlan)
{-# INLINE resourcesPlanL #-}
resourcesSocketDirectoryL :: Lens' Resources CompleteDirectoryType
resourcesSocketDirectoryL f resources@Resources {..}
= fmap (\x -> resources { resourcesSocketDirectory = x })
(f resourcesSocketDirectory)
{-# INLINE resourcesSocketDirectoryL #-}
dataDirectoryL :: Lens' Config DirectoryType
dataDirectoryL f config@Config{..}
= fmap (\ x -> config { dataDirectory = x } )
(f dataDirectory)
{-# INLINE dataDirectoryL #-}
planL :: Lens' Config Plan
planL f config@Config{..}
= fmap (\ x -> config { plan = x } )
(f plan)
{-# INLINE planL #-}
portL :: Lens' Config (Last (Maybe Int))
portL f config@Config{..}
= fmap (\ x -> config { port = x } )
(f port)
{-# INLINE portL #-}
socketDirectoryL :: Lens' Config DirectoryType
socketDirectoryL f config@Config{..}
= fmap (\ x -> config { socketDirectory = x } )
(f socketDirectory)
{-# INLINE socketDirectoryL #-}
temporaryDirectoryL :: Lens' Config (Last FilePath)
temporaryDirectoryL f config@Config{..}
= fmap (\ x -> config { temporaryDirectory = x } )
(f temporaryDirectory)
{-# INLINE temporaryDirectoryL #-}
indexBasedL ::
Lens' CommandLineArgs (Map Int String)
indexBasedL
f_amNr
(CommandLineArgs x_amNs x_amNt)
= fmap (CommandLineArgs x_amNs)
(f_amNr x_amNt)
{-# INLINE indexBasedL #-}
keyBasedL ::
Lens' CommandLineArgs (Map String (Maybe String))
keyBasedL
f_amNv
(CommandLineArgs x_amNw x_amNx)
= fmap (`CommandLineArgs` x_amNx)
(f_amNv x_amNw)
{-# INLINE keyBasedL #-}
sourceDirectoryL :: Lens' CopyDirectoryCommand FilePath
sourceDirectoryL f cmd@CopyDirectoryCommand{..}
= fmap (\x -> cmd { sourceDirectory = x })
(f sourceDirectory)
{-# INLINE sourceDirectoryL #-}
destinationDirectoryL :: Lens' CopyDirectoryCommand (Maybe FilePath)
destinationDirectoryL f cmd@CopyDirectoryCommand{..}
= fmap (\x -> cmd { destinationDirectory = x })
(f destinationDirectory)
{-# INLINE destinationDirectoryL #-}
useCopyOnWriteL :: Lens' CopyDirectoryCommand Bool
useCopyOnWriteL f cmd@CopyDirectoryCommand{..}
= fmap (\x -> cmd { useCopyOnWrite = x })
(f useCopyOnWrite)
{-# INLINE useCopyOnWriteL #-}