morph (empty) → 0.1.0.0

raw patch · 7 files changed

+336/−0 lines, 7 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, directory, filepath, morph, optparse-applicative, postgresql-simple, text, yaml

Files

LICENSE +30/−0
Main.hs +10/−0
Setup.hs +2/−0
morph.cabal +48/−0
src/Morph/Config.hs +88/−0
src/Morph/Migrator.hs +122/−0
src/Morph/Options.hs +36/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2016, Thomas Feron++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Thomas Feron nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Main.hs view

@@ -0,0 +1,10 @@+import Morph.Config+import Morph.Migrator+import Morph.Options++main :: IO ()+main = do+  opts   <- getOptions+  config <- readConfigOrDie opts+  withConnection config $ \conn -> do+    migrate conn $ optsMigrationsDirectory opts

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ morph.cabal view

@@ -0,0 +1,48 @@+-- Initial morph.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/++name:                  morph+version:               0.1.0.0+synopsis:              A simple database migrator for PostgreSQL+description:           Morph is a tool to migrate your PostgreSQL databases+                       safely which supports rollbacks.+license:               BSD3+license-file:          LICENSE+author:                Thomas Feron+maintainer:            tho.feron@gmail.com+build-type:            Simple+cabal-version:         >=1.10++source-repository head+  type:                darcs+  location:            http://darcs.redspline.com/morph+  tag:                 0.1.0.0++library+  hs-source-dirs:      src+  ghc-options:         -Wall+  default-language:    Haskell2010++  default-extensions:  OverloadedStrings++  exposed-modules:     Morph.Config+                       Morph.Migrator+                       Morph.Options++  build-depends:       base >=4.8 && <4.9+                     , optparse-applicative ==0.12.*+                     , aeson+                     , yaml+                     , postgresql-simple+                     , bytestring+                     , text+                     , directory+                     , filepath++executable morph+  main-is:             Main.hs+  hs-source-dirs:      .+  ghc-options:         -Wall+  default-language:    Haskell2010+  build-depends:       base >=4.8 && <4.9+                     , morph

+ src/Morph/Config.hs view

@@ -0,0 +1,88 @@+module Morph.Config+  ( readConfigOrDie+  , withConnection+  ) where++import           Control.Exception++import           Data.Maybe+import qualified Data.Aeson                 as J+import qualified Data.Aeson.Types           as J hiding (Options)+import qualified Data.Yaml                  as Y+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text                  as T++import           System.Exit+import           System.IO++import           Database.PostgreSQL.Simple++import           Morph.Options++data Config = Config+  { configUsername :: String+  , configPassword :: String+  , configHostname :: String+  , configPort     :: Integer+  , configName     :: String+  }++instance J.FromJSON Config where+  parseJSON = J.withObject "Config" $ \obj -> Config+    <$> obj J..: "username"+    <*> obj J..: "password"+    <*> obj J..: "hostname"+    <*> obj J..: "port"+    <*> obj J..: "name"++parseJSONConfig :: [T.Text] -> J.Value -> J.Parser Config+parseJSONConfig [] = J.parseJSON+parseJSONConfig (key : keys) = J.withObject "Parent object" $ \obj -> do+  val <- obj J..: key+  parseJSONConfig keys val++parseYAMLConfig :: [T.Text] -> Y.Value -> Y.Parser Config+parseYAMLConfig [] val = Y.parseJSON val+parseYAMLConfig (key : keys) (Y.Object obj) = do+  val <- obj Y..: key+  parseYAMLConfig keys val+parseYAMLConfig _ _ = fail "Object expected"++readConfigOrDie :: Options -> IO Config+readConfigOrDie opts = do+  contents <- BSL.readFile $+    fromMaybe (if optsJSONConfig opts then "config.json" else "config.yml")+              (optsConfigFile opts)++  let eConfig+        | optsJSONConfig opts = do+            val <- J.eitherDecode contents+            J.parseEither (parseJSONConfig (optsKeysPath opts)) val+        | otherwise = do+            val <- Y.decodeEither $ BSL.toStrict contents+            Y.parseEither (parseYAMLConfig (optsKeysPath opts)) val++  case eConfig of+    Right config -> return config+    Left err -> do+      hPutStrLn stderr $ "Can't read the config file: " ++ err+      exitFailure++createConn :: Config -> IO Connection+createConn config = connect ConnectInfo+  { connectHost     = configHostname config+  , connectUser     = configUsername config+  , connectPassword = configPassword config+  , connectDatabase = configName     config+  , connectPort     = fromInteger $ configPort config+  }++destroyConn :: Connection -> IO ()+destroyConn = close++withConnection :: Config -> (Connection -> IO a) -> IO a+withConnection config f = do+  conn <- createConn config+  res <- catch (f conn) $ \e -> destroyConn conn >> throw (e :: SomeException)+  destroyConn conn+  return res

+ src/Morph/Migrator.hs view

@@ -0,0 +1,122 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}++module Morph.Migrator+  ( migrate+  ) where++import Control.Monad++import Data.List+import Data.Maybe+import Data.Monoid+import Data.String++import System.Directory+import System.FilePath+import System.IO++import Database.PostgreSQL.Simple+import Database.PostgreSQL.Simple.FromRow++-- | A migration can either be read from file and contain both sides or from the+-- database and contain only the down side.+data MigrationType = Full | Rollback++type family MigrationSQL (a :: MigrationType) :: * where+  MigrationSQL 'Full     = (Query, String)+  MigrationSQL 'Rollback = Query++data Migration :: MigrationType -> * where+  Migration ::+    { migrationIdentifier :: String+    , migrationSQL        :: MigrationSQL a+    } -> Migration a++createMigrationTable :: Connection -> IO ()+createMigrationTable conn = void $ execute_ conn+  "CREATE TABLE IF NOT EXISTS migrations (\+  \  id           varchar PRIMARY KEY CHECK (id <> ''),\+  \  rollback_sql text CHECK (rollback_sql <> '')\+  \);"++listDone :: Connection -> IO [Migration 'Rollback]+listDone conn = do+  pairs <- query_ conn "SELECT id, rollback_sql FROM migrations ORDER BY id ASC"+  return $ flip map pairs $ \(identifier, mSQL) -> Migration+    { migrationIdentifier = identifier+    , migrationSQL        = maybe "" fromString mSQL+    }++listGoals :: FilePath -> IO [Migration 'Full]+listGoals dir = do+    allNames <- sort <$> getDirectoryContents dir+    let upNames     = filter (".up.sql"   `isSuffixOf`) allNames+        downNames   = filter (".down.sql" `isSuffixOf`) allNames++    forM upNames $ \upName -> do+      let identifier = extractIdentifier upName+      up   <- readMigrationFile upName+      down <- readDownMigrationFile downNames identifier+      return Migration+        { migrationIdentifier = identifier+        , migrationSQL        = (up, down)+        }++  where+    extractIdentifier :: FilePath -> String+    extractIdentifier = takeWhile (`elem` ("0123456789" :: String))++    readMigrationFile :: FilePath -> IO Query+    readMigrationFile path = do+      contents <- readFile $ dir </> path+      return $ fromString contents++    readDownMigrationFile :: [FilePath] -> String -> IO String+    readDownMigrationFile paths identifier =+      case find ((==identifier) . extractIdentifier) paths of+        Nothing -> return $+          "RAISE EXCEPTION 'No rollback migration found for "+          <> fromString identifier <> "';"+        Just path -> readFile $ dir </> path++rollbackMigration :: Connection -> Migration 'Rollback -> IO ()+rollbackMigration conn migration = do+  hPutStrLn stderr $+    "Rollbacking migration " ++ migrationIdentifier migration ++ " ..."+  void $ execute_ conn $ migrationSQL migration+  void $ execute conn "DELETE FROM migrations WHERE id = ?" $+    Only $ migrationIdentifier migration++doMigration :: Connection -> Migration 'Full -> IO ()+doMigration conn migration = do+  hPutStrLn stderr $+    "Running migration " ++ migrationIdentifier migration ++ " ..."+  let (up, down) = migrationSQL migration+  void $ execute_ conn up+  void $ execute conn "INSERT INTO migrations (id, rollback_sql) VALUES (?, ?)"+                 (migrationIdentifier migration, down)++migrate :: Connection -> FilePath -> IO ()+migrate conn dir = do+  createMigrationTable conn++  doneMigrations <- listDone  conn+  goalMigrations <- listGoals dir++  let doneIdentifiers = map migrationIdentifier doneMigrations+      goalIdentifiers = map migrationIdentifier goalMigrations++      toRollbackIdentifiers = doneIdentifiers \\ goalIdentifiers+      toDoIdentifiers       = goalIdentifiers \\ doneIdentifiers++      toRollback = filter ((`elem` toRollbackIdentifiers) . migrationIdentifier)+                          doneMigrations+      toDo       = filter ((`elem` toDoIdentifiers)       . migrationIdentifier)+                          goalMigrations++  withTransaction conn $ do+    forM_ toRollback $ rollbackMigration conn+    forM_ toDo       $ doMigration       conn

+ src/Morph/Options.hs view

@@ -0,0 +1,36 @@+module Morph.Options+  ( Options(..)+  , getOptions+  ) where++import qualified Data.Text as T++import           Options.Applicative++data Options = Options+  { optsConfigFile          :: Maybe FilePath+  , optsKeysPath            :: [T.Text]+  , optsMigrationsDirectory :: FilePath+  , optsJSONConfig          :: Bool+  }++optionsParser :: Parser Options+optionsParser = Options+  <$> option (Just <$> str)+             (short 'c' <> long "config" <> metavar "PATH"+              <> value Nothing <> help "Path to the config file.")+  <*> option ((T.splitOn "." . T.pack) <$> str)+             (short 'p' <> long "path" <> metavar "KEY1[.KEY2[...]]"+              <> value [] <> help "The keys to traverse in the JSON to find\+                                  \ the database connection info.")+  <*> strOption (short 'd' <> long "dir" <> metavar "PATH"+                 <> showDefault <> value "migrations"+                 <> help "Path to the directory containing migrations.")+  <*> flag False True (short 'j' <> long "json"+                       <> help "Read config file as JSON.")++getOptions :: IO Options+getOptions = execParser $ info (helper <*> optionsParser) $+  fullDesc+  <> progDesc "Migrator for PostgreSQL databases with support for rollbacks"+  <> footer "This program is licensed under the BSD-3 license."