dbmigrations 0.6 → 0.7
raw patch · 6 files changed
+720/−40 lines, 6 filesdep +configuratordep +textdep ~directory
Dependencies added: configurator, text
Dependency ranges changed: directory
Files
- dbmigrations.cabal +9/−3
- src/Moo.hs +35/−37
- src/Moo/CommandHandlers.hs +178/−0
- src/Moo/CommandInterface.hs +135/−0
- src/Moo/CommandUtils.hs +248/−0
- src/Moo/Core.hs +115/−0
dbmigrations.cabal view
@@ -1,5 +1,5 @@ Name: dbmigrations-Version: 0.6+Version: 0.7 Synopsis: An implementation of relational database "migrations" Description: A library and program for the creation, management, and installation of schema updates@@ -50,11 +50,13 @@ containers >= 0.2 && < 0.6, mtl == 2.1.*, filepath >= 1.1 && < 1.4,- directory >= 1.0 && < 1.2,+ directory >= 1.0 && < 1.3, fgl >= 5.4 && < 5.5, template-haskell, yaml-light >= 0.1 && < 0.2,- bytestring >= 0.9 && < 1.0+ bytestring >= 0.9 && < 1.0,+ text == 0.11.*,+ configurator == 0.2.* Hs-Source-Dirs: src Exposed-Modules:@@ -69,6 +71,10 @@ Other-Modules: Database.Schema.Migrations.CycleDetection Database.Schema.Migrations.Filesystem.Serialize+ Moo.CommandHandlers+ Moo.CommandInterface+ Moo.CommandUtils+ Moo.Core Executable dbmigrations-tests Build-Depends:
src/Moo.hs view
@@ -2,26 +2,26 @@ ( main ) where -import Control.Monad.Reader (forM_, runReaderT, when)-import Control.Applicative ((<$>))-import Data.List (intercalate)-import Data.Maybe (fromMaybe)-import System.Exit (ExitCode (ExitFailure), exitWith)-import System.Environment (getArgs, getEnvironment, getProgName)-import Database.HDBC (SqlError, catchSql, seErrorMsg)--import Database.Schema.Migrations.Filesystem ( FilesystemStore (..) )-import Database.Schema.Migrations.Store-import Moo.CommandInterface-import Moo.Core-+import Control.Monad (liftM)+import Control.Monad.Reader (forM_, runReaderT, when)+import Data.Configurator+import Data.List (intercalate)+import Data.Maybe (fromMaybe)+import Database.HDBC (SqlError, catchSql, seErrorMsg)+import Prelude hiding (lookup)+import System.Environment (getArgs, getEnvironment, getProgName)+import System.Exit (ExitCode (ExitFailure), exitWith)+ +import Database.Schema.Migrations.Filesystem (FilesystemStore (..))+import Database.Schema.Migrations.Store+import Moo.CommandInterface+import Moo.Core reportSqlError :: SqlError -> IO a reportSqlError e = do putStrLn $ "\n" ++ "A database error occurred: " ++ seErrorMsg e exitWith (ExitFailure 1) - usage :: IO a usage = do progName <- getProgName@@ -41,12 +41,14 @@ putStrLn commandOptionUsage exitWith (ExitFailure 1) - usageSpecific :: Command -> IO a usageSpecific command = do putStrLn $ "Usage: initstore-fs " ++ usageString command exitWith (ExitFailure 1) +loadConfiguration :: Maybe FilePath -> IO Configuration+loadConfiguration Nothing = liftM fromShellEnvironment getEnvironment+loadConfiguration (Just path) = fromConfigurator =<< load [Required path] main :: IO () main = do@@ -56,23 +58,20 @@ command <- case findCommand commandName of Nothing -> usage- Just c -> return c+ Just c -> return c (opts, required) <- getCommandArgs unprocessedArgs - -- Read store path and database connection string from environment- -- or config file (for now, we just look at the environment). Also,- -- require them both to be set for every operation, even though some- -- operations only require the store path.- env <- getEnvironment- let mDbConnStr = lookup envDatabaseName env- mDbType = lookup envDatabaseType env- storePathStr = fromMaybe- (error $ - "Error: missing required environment \- \variable " ++ envStoreName)- (lookup envStoreName env)+ let optionalConfigPath = _configFilePath opts + conf <- loadConfiguration optionalConfigPath+ let mDbConnStr = _connectionString conf+ let mDbType = _databaseType conf+ let mStoreName = _migrationStorePath conf+ let storePathStr =+ fromMaybe (error $ "Error: missing required environment variable " ++ envStoreName)+ mStoreName+ let store = FSStore { storePath = storePathStr } if length required < length ( _cRequired command) then@@ -84,14 +83,13 @@ putStrLn "There were errors in the migration store:" forM_ es $ \err -> putStrLn $ " " ++ show err Right storeData -> do- let st = AppState { _appOptions = opts- , _appCommand = command- , _appRequiredArgs = required- , _appOptionalArgs = ["" :: String]- , _appDatabaseConnStr = DbConnDescriptor <$>- mDbConnStr- , _appDatabaseType = mDbType- , _appStore = FSStore storePathStr- , _appStoreData = storeData+ let st = AppState { _appOptions = opts+ , _appCommand = command+ , _appRequiredArgs = required+ , _appOptionalArgs = ["" :: String]+ , _appDatabaseConnStr = liftM DbConnDescriptor mDbConnStr+ , _appDatabaseType = mDbType+ , _appStore = FSStore storePathStr+ , _appStoreData = storeData } runReaderT (_cHandler command storeData) st `catchSql` reportSqlError
+ src/Moo/CommandHandlers.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Moo.CommandHandlers where++import Moo.Core+import Moo.CommandUtils+import Control.Monad ( when, forM_ )+import Data.Maybe ( isJust )+import Control.Monad.Reader ( asks )+import System.Exit ( exitWith, ExitCode(..), exitSuccess )+import Control.Monad.Trans ( liftIO )+import Database.HDBC ( IConnection(commit, rollback))++import Database.Schema.Migrations.Store hiding (getMigrations)+import Database.Schema.Migrations+import Database.Schema.Migrations.Backend+++newCommand :: CommandHandler+newCommand storeData = do+ required <- asks _appRequiredArgs+ store <- asks _appStore+ let [migrationId] = required+ noAsk <- fmap _noAsk $ asks _appOptions++ liftIO $ do+ fullPath <- fullMigrationName store migrationId++ when (isJust $ storeLookup storeData migrationId) $+ do+ putStrLn $ "Migration " ++ (show fullPath) ++ " already exists"+ exitWith (ExitFailure 1)++ -- Default behavior: ask for dependencies+ deps <- if noAsk then (return []) else+ do+ putStrLn $ "Selecting dependencies for new \+ \migration: " ++ migrationId+ interactiveAskDeps storeData++ result <- if noAsk then (return True) else+ (confirmCreation migrationId deps)++ case result of+ True -> do+ status <- createNewMigration store migrationId deps+ case status of+ Left e -> putStrLn e >> (exitWith (ExitFailure 1))+ Right _ -> putStrLn $ "Migration created successfully: " +++ show fullPath+ False -> do+ putStrLn "Migration creation cancelled."+++upgradeCommand :: CommandHandler+upgradeCommand storeData = do+ isTesting <- fmap _test $ asks _appOptions+ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ migrationNames <- missingMigrations conn storeData+ when (null migrationNames) $ do+ putStrLn "Database is up to date."+ exitSuccess+ forM_ migrationNames $ \migrationName -> do+ m <- lookupMigration storeData migrationName+ apply m storeData conn False+ case isTesting of+ True -> do+ rollback conn+ putStrLn "Upgrade test successful."+ False -> do+ commit conn+ putStrLn "Database successfully upgraded."+++upgradeListCommand :: CommandHandler+upgradeListCommand storeData = do+ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ migrationNames <- missingMigrations conn storeData+ when (null migrationNames) $ do+ putStrLn "Database is up to date."+ exitSuccess+ putStrLn "Migrations to install:"+ forM_ migrationNames (putStrLn . (" " ++))+++reinstallCommand :: CommandHandler+reinstallCommand storeData = do+ isTesting <- fmap _test $ asks _appOptions+ required <- asks _appRequiredArgs+ let [migrationId] = required++ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ m <- lookupMigration storeData migrationId++ revert m storeData conn+ apply m storeData conn True++ case isTesting of+ False -> do+ commit conn+ putStrLn "Migration successfully reinstalled."+ True -> do+ rollback conn+ putStrLn "Reinstall test successful."+++listCommand :: CommandHandler+listCommand _ = do+ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ ms <- getMigrations conn+ forM_ ms $ \m ->+ when (not $ m == rootMigrationName) $ putStrLn m+++applyCommand :: CommandHandler+applyCommand storeData = do+ isTesting <- fmap _test $ asks _appOptions+ required <- asks _appRequiredArgs+ let [migrationId] = required++ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ m <- lookupMigration storeData migrationId+ apply m storeData conn True+ case isTesting of+ False -> do+ commit conn+ putStrLn "Successfully applied migrations."+ True -> do+ rollback conn+ putStrLn "Migration installation test successful."+++revertCommand :: CommandHandler+revertCommand storeData = do+ isTesting <- fmap _test $ asks _appOptions+ required <- asks _appRequiredArgs+ let [migrationId] = required++ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ m <- lookupMigration storeData migrationId+ revert m storeData conn++ case isTesting of+ False -> do+ commit conn+ putStrLn "Successfully reverted migrations."+ True -> do+ rollback conn+ putStrLn "Migration uninstallation test successful."+++testCommand :: CommandHandler+testCommand storeData = do+ required <- asks _appRequiredArgs+ let [migrationId] = required++ withConnection $ \(AnyIConnection conn) -> do+ ensureBootstrappedBackend conn >> commit conn+ m <- lookupMigration storeData migrationId+ migrationNames <- missingMigrations conn storeData+ -- If the migration is already installed, remove it as part of+ -- the test+ when (not $ migrationId `elem` migrationNames) $+ do revert m storeData conn+ return ()+ applied <- apply m storeData conn True+ forM_ (reverse applied) $ \migration -> do+ revert migration storeData conn+ rollback conn+ putStrLn "Successfully tested migrations."
+ src/Moo/CommandInterface.hs view
@@ -0,0 +1,135 @@+-- |This module defines the MOO command interface, the commnad line options+-- parser, and helpers to manipulate the Command data structure.+module Moo.CommandInterface+ ( commands+ , commandOptionUsage+ , findCommand+ , getCommandArgs+ , usageString+ ) where++import Data.Maybe+import Moo.CommandHandlers+import Moo.Core+import System.Console.GetOpt+++-- |The available commands; used to dispatch from the command line and+-- used to generate usage output.+-- |The available commands; used to dispatch from the command line and+-- used to generate usage output.+commands :: [Command]+commands = [ Command "new" [migrationName]+ []+ ["no-ask", configFile]+ "Create a new empty migration"+ newCommand++ , Command "apply" [migrationName]+ []+ [testOption, configFile]+ "Apply the specified migration and its \+ \dependencies"+ applyCommand++ , Command "revert" [migrationName]+ []+ [testOption, configFile]+ "Revert the specified migration and those \+ \that depend on it"+ revertCommand++ , Command "test" [migrationName]+ []+ [configFile]+ "Test the specified migration by applying \+ \and reverting it in a transaction, then \+ \roll back"+ testCommand++ , Command "upgrade" []+ []+ [testOption, configFile]+ "Install all migrations that have not yet \+ \been installed"++ upgradeCommand++ , Command "upgrade-list" []+ []+ []+ "Show the list of migrations not yet \+ \installed"+ upgradeListCommand++ , Command "reinstall" [migrationName]+ []+ [testOption, configFile]+ "Reinstall a migration by reverting, then \+ \reapplying it"+ reinstallCommand++ , Command "list" []+ []+ [configFile]+ "List migrations already installed in the backend"+ listCommand+ ]+ where migrationName = "migrationName"+ testOption = "test"+ configFile = "config-file"+++findCommand :: String -> Maybe Command+findCommand name = listToMaybe [ c | c <- commands, _cName c == name ]+++commandOptions :: [ OptDescr (CommandOptions -> IO CommandOptions) ]+commandOptions = [ optionConfigFile+ , optionTest+ , optionNoAsk+ ]+++optionConfigFile :: OptDescr (CommandOptions -> IO CommandOptions)+optionConfigFile = Option "c" ["config-file"]+ (ReqArg (\arg opt ->+ return opt { _configFilePath = Just arg }) "FILE")+ "Specify location of configuration file"+++optionTest :: OptDescr (CommandOptions -> IO CommandOptions)+optionTest = Option "t" ["test"]+ (NoArg (\opt -> return opt { _test = True }))+ "Perform the action then rollback when finished"+++optionNoAsk :: OptDescr (CommandOptions -> IO CommandOptions)+optionNoAsk = Option "n" ["no-ask"]+ (NoArg (\opt -> return opt { _noAsk = True }))+ "Do not interactively ask any questions, just do it"+++getCommandArgs :: [String] -> IO ( CommandOptions, [String] )+getCommandArgs args = do+ let (actions, required, _) = getOpt RequireOrder commandOptions args+ opts <- foldl (>>=) defaultOptions actions+ return ( opts, required )+++defaultOptions :: IO CommandOptions+defaultOptions = return $ CommandOptions Nothing False False+++commandOptionUsage :: String+commandOptionUsage = usageInfo "Options:" commandOptions+++usageString :: Command -> String+usageString command =+ unwords (_cName command:optionalArgs ++ options ++ requiredArgs)+ where+ requiredArgs = map (\s -> "<" ++ s ++ ">") $ _cRequired command+ optionalArgs = map (\s -> "[" ++ s ++ "]") $ _cOptional command+ options = map (\s -> "["++ "--" ++ s ++ "]") optionStrings+ optionStrings = _cAllowedOptions command
+ src/Moo/CommandUtils.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE FlexibleContexts #-}++module Moo.CommandUtils+ ( apply+ , confirmCreation+ , interactiveAskDeps+ , lookupMigration+ , revert+ , withConnection+ ) where++import Control.Exception ( bracket )+import Control.Monad ( when, forM_, unless )+import Control.Monad.Reader ( asks )+import Control.Monad.Trans ( liftIO )+import Data.List ( intercalate, sortBy )+import Data.Maybe ( fromJust, isNothing, isJust )+import System.Exit ( exitWith, ExitCode(..) )+import System.IO ( stdout, hFlush, hGetBuffering+ , hSetBuffering, stdin, BufferMode(..) )+import Database.HDBC ( IConnection, disconnect )+++import Database.Schema.Migrations ( migrationsToApply, migrationsToRevert )+import Database.Schema.Migrations.Backend ( Backend+ , applyMigration+ , revertMigration+ )+import Database.Schema.Migrations.Migration ( Migration(..) )+import Database.Schema.Migrations.Store ( StoreData+ , storeLookup+ , storeMigrations+ )+import Moo.Core+++apply :: (IConnection b, Backend b IO)+ => Migration -> StoreData -> b -> Bool -> IO [Migration]+apply m storeData backend complain = do+ -- Get the list of migrations to apply+ toApply <- migrationsToApply storeData backend m++ -- Apply them+ if null toApply then+ nothingToDo >> return [] else+ mapM_ (applyIt backend) toApply >> return toApply++ where+ nothingToDo =+ when complain $+ putStrLn $ "Nothing to do; " +++ mId m +++ " already installed."++ applyIt conn it = do+ putStr $ "Applying: " ++ mId it ++ "... "+ applyMigration conn it+ putStrLn "done."+++revert :: (IConnection b, Backend b IO)+ => Migration -> StoreData -> b -> IO [Migration]+revert m storeData backend = do+ -- Get the list of migrations to revert+ toRevert <- liftIO $ migrationsToRevert storeData backend m++ -- Revert them+ if null toRevert then+ nothingToDo >> return [] else+ mapM_ (revertIt backend) toRevert >> return toRevert++ where+ nothingToDo =+ putStrLn $ "Nothing to do; " +++ mId m +++ " not installed."++ revertIt conn it = do+ putStr $ "Reverting: " ++ mId it ++ "... "+ revertMigration conn it+ putStrLn "done."+++lookupMigration :: StoreData -> String -> IO Migration+lookupMigration storeData name = do+ let theMigration = storeLookup storeData name+ case theMigration of+ Nothing -> do+ putStrLn $ "No such migration: " ++ name+ exitWith (ExitFailure 1)+ Just m' -> return m'+++-- Given a database type string and a database connection string,+-- return a database connection or raise an error if the database+-- connection cannot be established, or if the database type is not+-- supported.+makeConnection :: String -> DbConnDescriptor -> IO AnyIConnection+makeConnection dbType (DbConnDescriptor connStr) =+ case lookup dbType databaseTypes of+ Nothing -> error $ "Unsupported database type " ++ show dbType +++ " (supported types: " +++ intercalate "," (map fst databaseTypes) ++ ")"+ Just mkConnection -> mkConnection connStr+++-- Given an action that needs a database connection, connect to the+-- database using the application configuration and invoke the action+-- with the connection. Return its result.+withConnection :: (AnyIConnection -> IO a) -> AppT a+withConnection act = do+ mDbPath <- asks _appDatabaseConnStr+ when (isNothing mDbPath) $ error $ "Error: Database connection string not \+ \specified, please set " ++ envDatabaseName+ mDbType <- asks _appDatabaseType+ when (isNothing mDbType) $+ error $ "Error: Database type not specified, " +++ "please set " ++ envDatabaseType +++ " (supported types: " +++ intercalate "," (map fst databaseTypes) ++ ")"+ liftIO $ bracket (makeConnection (fromJust mDbType) (fromJust mDbPath))+ (\(AnyIConnection conn) -> disconnect conn) act+++-- Given a migration name and selected dependencies, get the user's+-- confirmation that a migration should be created.+confirmCreation :: String -> [String] -> IO Bool+confirmCreation migrationId deps = do+ putStrLn ""+ putStrLn $ "Confirm: create migration '" ++ migrationId ++ "'"+ if null deps then putStrLn " (No dependencies)"+ else putStrLn "with dependencies:"+ forM_ deps $ \d -> putStrLn $ " " ++ d+ prompt "Are you sure?" [ ('y', (True, Nothing))+ , ('n', (False, Nothing))+ ]+++-- Prompt the user for a choice, given a prompt and a list of possible+-- choices. Let the user get help for the available choices, and loop+-- until the user makes a valid choice.+prompt :: (Eq a) => String -> PromptChoices a -> IO a+prompt _ [] = error "prompt requires a list of choices"+prompt message choiceMap = do+ putStr $ message ++ " (" ++ choiceStr ++ helpChar ++ "): "+ hFlush stdout+ c <- unbufferedGetChar+ case lookup c choiceMap of+ Nothing -> do+ when (c /= '\n') $ putStrLn ""+ when (c == 'h') $ putStr $ mkPromptHelp choiceMapWithHelp+ retry+ Just (val, _) -> putStrLn "" >> return val+ where+ retry = prompt message choiceMap+ choiceStr = intercalate "" $ map (return . fst) choiceMap+ helpChar = if hasHelp choiceMap then "h" else ""+ choiceMapWithHelp = choiceMap ++ [('h', (undefined, Just "this help"))]+++-- Given a PromptChoices, build a multi-line help string for those+-- choices using the description information in the choice list.+mkPromptHelp :: PromptChoices a -> String+mkPromptHelp choices =+ intercalate "" [ [c] ++ ": " ++ fromJust msg ++ "\n" |+ (c, (_, msg)) <- choices, isJust msg ]+++-- Does the specified prompt choice list have any help messages in it?+hasHelp :: PromptChoices a -> Bool+hasHelp = (> 0) . length . filter hasMsg+ where hasMsg (_, (_, m)) = isJust m+++-- A general type for a set of choices that the user can make at a+-- prompt.+type PromptChoices a = [(Char, (a, Maybe String))]+++-- Get an input character in non-buffered mode, then restore the+-- original buffering setting.+unbufferedGetChar :: IO Char+unbufferedGetChar = do+ bufferingMode <- hGetBuffering stdin+ hSetBuffering stdin NoBuffering+ c <- getChar+ hSetBuffering stdin bufferingMode+ return c+++-- The types for choices the user can make when being prompted for+-- dependencies.+data AskDepsChoice = Yes | No | View | Done | Quit+ deriving (Eq)+++-- Interactively ask the user about which dependencies should be used+-- when creating a new migration.+interactiveAskDeps :: StoreData -> IO [String]+interactiveAskDeps storeData = do+ -- For each migration in the store, starting with the most recently+ -- added, ask the user if it should be added to a dependency list+ let sorted = sortBy compareTimestamps $ storeMigrations storeData+ interactiveAskDeps' storeData (map mId sorted)+ where+ compareTimestamps m1 m2 = compare (mTimestamp m2) (mTimestamp m1)+++-- Recursive function to prompt the user for dependencies and let the+-- user view information about potential dependencies. Returns a list+-- of migration names which were selected.+interactiveAskDeps' :: StoreData -> [String] -> IO [String]+interactiveAskDeps' _ [] = return []+interactiveAskDeps' storeData (name:rest) = do+ result <- prompt ("Depend on '" ++ name ++ "'?") askDepsChoices+ if result == Done then return [] else+ case result of+ Yes -> do+ next <- interactiveAskDeps' storeData rest+ return $ name:next+ No -> interactiveAskDeps' storeData rest+ View -> do+ -- load migration+ let Just m = storeLookup storeData name+ -- print out description, timestamp, deps+ when (isJust $ mDesc m)+ (putStrLn $ " Description: " +++ fromJust (mDesc m))+ putStrLn $ " Created: " ++ show (mTimestamp m)+ unless (null $ mDeps m)+ (putStrLn $ " Deps: " +++ intercalate "\n " (mDeps m))+ -- ask again+ interactiveAskDeps' storeData (name:rest)+ Quit -> do+ putStrLn "cancelled."+ exitWith (ExitFailure 1)+ Done -> return []+++-- The choices the user can make when being prompted for dependencies.+askDepsChoices :: PromptChoices AskDepsChoice+askDepsChoices = [ ('y', (Yes, Just "yes, depend on this migration"))+ , ('n', (No, Just "no, do not depend on this migration"))+ , ('v', (View, Just "view migration details"))+ , ('d', (Done, Just "done, do not ask me about more dependencies"))+ , ('q', (Quit, Just "cancel this operation and quit"))+ ]
+ src/Moo/Core.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE ExistentialQuantification #-}++module Moo.Core where++import Control.Applicative ((<$>), (<*>))+import Control.Monad.Reader (ReaderT)+import qualified Data.Configurator as C+import Data.Configurator.Types (Config)+import qualified Data.Text as T+import Database.HDBC (IConnection)+import Database.HDBC.PostgreSQL (connectPostgreSQL)+import Database.HDBC.Sqlite3 (connectSqlite3)++import Database.Schema.Migrations ()+import Database.Schema.Migrations.Backend.HDBC ()+import Database.Schema.Migrations.Filesystem (FilesystemStore)+import Database.Schema.Migrations.Store (StoreData)+++-- |The monad in which the application runs.+type AppT a = ReaderT AppState IO a+++-- |The type of actions that are invoked to handle specific commands+type CommandHandler = StoreData -> AppT ()+++-- |Application state which can be accessed by any command handler.+data AppState = AppState { _appOptions :: CommandOptions+ , _appCommand :: Command+ , _appRequiredArgs :: [String]+ , _appOptionalArgs :: [String]+ , _appStore :: FilesystemStore+ , _appDatabaseConnStr :: Maybe DbConnDescriptor+ , _appDatabaseType :: Maybe String+ , _appStoreData :: StoreData+ }++type ShellEnvironment = [(String, String)]++data Configuration = Configuration+ { _connectionString :: Maybe String+ , _databaseType :: Maybe String+ , _migrationStorePath :: Maybe FilePath+ }++fromShellEnvironment :: ShellEnvironment -> Configuration+fromShellEnvironment env = Configuration connectionString+ databaseType+ migrationStorePath+ where+ connectionString = envLookup envDatabaseName+ databaseType = envLookup envDatabaseType+ migrationStorePath = envLookup envStoreName+ envLookup = (\evar -> lookup evar env)++fromConfigurator :: Config -> IO Configuration+fromConfigurator conf = Configuration <$> connectionString+ <*> databaseType+ <*> migrationStorePath+ where+ connectionString = configLookup envDatabaseName+ databaseType = configLookup envDatabaseType+ migrationStorePath = configLookup envStoreName+ configLookup = C.lookup conf . T.pack++-- |Type wrapper for IConnection instances so the makeConnection+-- function can return any type of connection.+data AnyIConnection = forall c. (IConnection c) => AnyIConnection c+++-- |CommandOptions are those options that can be specified at the command+-- prompt to modify the behavior of a command.+data CommandOptions = CommandOptions { _configFilePath :: Maybe String+ , _test :: Bool+ , _noAsk :: Bool+ }+++-- |A command has a name, a number of required arguments' labels, a+-- number of optional arguments' labels, and an action to invoke.+data Command = Command { _cName :: String+ , _cRequired :: [String]+ , _cOptional :: [String]+ , _cAllowedOptions :: [String]+ , _cDescription :: String+ , _cHandler :: CommandHandler+ }+++-- |ConfigOptions are those options read from configuration file+data ConfigData = ConfigData { _dbTypeStr :: String+ , _dbConnStr :: String+ , _fileStorePath :: String+ }+++newtype DbConnDescriptor = DbConnDescriptor String+++-- |The values of DBM_DATABASE_TYPE and their corresponding connection+-- factory functions.+databaseTypes :: [(String, String -> IO AnyIConnection)]+databaseTypes = [ ("postgresql", fmap AnyIConnection . connectPostgreSQL)+ , ("sqlite3", fmap AnyIConnection . connectSqlite3)+ ]++envDatabaseType :: String+envDatabaseType = "DBM_DATABASE_TYPE"++envDatabaseName :: String+envDatabaseName = "DBM_DATABASE"++envStoreName :: String+envStoreName = "DBM_MIGRATION_STORE"