database-migrate (empty) → 0.0.1

raw patch · 6 files changed

+218/−0 lines, 6 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, directory, either, filepath, postgresql-simple, text, time, transformers

Files

• LICENSE +27/−0
• Setup.hs +3/−0
• database-migrate.cabal +58/−0
• src/Database/Migrate.hs +21/−0
• src/Database/Migrate/Core.hs +72/−0
• src/Database/Migrate/PostgreSQL.hs +37/−0

@@ -0,0 +1,27 @@+Copyright (c) 2010, Mark Hibberd <mark@hibberd.id.au>+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ 1. Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.+ 2. 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.+ 3. Neither the name of the <ORGANIZATION> nor the names of its 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 HOLDER 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.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,58 @@+Name:               database-migrate+Version:            0.0.1+License:            BSD3+License-File:       LICENSE+Author:             Mark Hibberd <mark@hibberd.id.au>+Maintainer:         Mark Hibberd <mark@hibberd.id.au>+Copyright:          (c) 2012 Mark Hibberd+Synopsis:           Database versioning and migration+Category:           Database+Homepage:           https://github.com/markhibberd/database-migrate+Bug-reports:           https://github.com/markhibberd/database-migrate/issues+Cabal-Version:      >= 1.6+Build-Type:         Simple+Description:+  A database versioning and migration library.+  .+  /Note/: that this library is under heavy development, currently+  the PostgreSQL implementation is functional, but+  expected to change. It is intended that a type safe+  migration api and command line tools be added to this+  library before it be considered stable.++Source-Repository   head+  Type:             git+  Location:         https://github.com/markhibberd/migrate.git++Flag                small_base+  Description:      Choose the new, split-up base package.++Library+  Build-Depends:+                    base >= 3 && < 5+                    , text                          >= 0.11       && < 0.12+                    , directory                     >= 1.0        && < 2.0+                    , filepath                      >= 1.0        && < 2.0+                    , bytestring                    >= 0.9        && < 0.10+                    , time                          >= 1.0        && < 2.0+                    , postgresql-simple             >= 0.1        && < 1.0+                    , containers                    >= 0.4        && < 0.5+                    , either                        >= 3.0.2      && < 4.0+                    , transformers                  >= 0.2        && < 0.4++  GHC-Options:+                    -Wall -fno-warn-orphans++  Hs-Source-Dirs:+                    src++  Exposed-Modules:+                    Database.Migrate+                    Database.Migrate.Core+                    Database.Migrate.PostgreSQL++  Extensions:+                    MultiParamTypeClasses+                    OverloadedStrings++

@@ -0,0 +1,21 @@+-- |+-- Module:      Database.Migrate+-- Copyright:   (c) 2012 Mark Hibberd+-- License:     BSD3+-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>+-- Portability: portable+--+-- A library to assist with managing database versioning+-- and migration.+--+-- Note: This library is under heavy development, currently+--       the PostgreSQL implementation is functional, but+--       expected to change. It is intended that a type safe+--       migration api and command line tools be added to this+--       library before it be considered stable.+module Database.Migrate (module X) where++import Database.Migrate.Core as X+-- import Database.Migrate.MySQL as X+import Database.Migrate.PostgreSQL as X+

@@ -0,0 +1,72 @@+{-#LANGUAGE OverloadedStrings #-}+module Database.Migrate.Core where++import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Either++import qualified Data.Set as S+import Data.Text hiding (foldr, filter, reverse, length)++import System.FilePath+import System.Directory+import System.IO++type MigrationId = Text+type Ddl = Text++data Migration =+  Migration {+      migration :: MigrationId+    , up :: Text+    , down :: Text+    , upsource :: Maybe FilePath+    , downsource :: Maybe FilePath+    }++data Context = Context {+    succeeded :: [MigrationId]+  , failed :: MigrationId+  , msg :: Text+  , rolledback :: Bool+  } deriving (Eq, Show)++type MigrationResultT = EitherT Context++class Monad m => MigrateDatabase m c where+  initialize :: c -> m ()+  runMigrations :: c -> (Migration -> Ddl) -> [Migration] -> MigrationResultT m [MigrationId]+  getMigrations :: c -> m [MigrationId]++pick :: [Migration] -> [MigrationId] -> [Migration]+pick ms ids =+  let available = foldr (S.insert . migration) S.empty ms+      installed = S.fromList ids+      torun = S.difference available installed+   in filter (\m -> S.member (migration m) torun) ms++latest :: MigrateDatabase m c => c -> [Migration] -> MigrationResultT m [MigrationId]+latest c migrations =+  lift (getMigrations c) >>= \installed -> runMigrations c up (pick migrations installed)++find :: FilePath -> EitherT String IO [Migration]+find b = liftIO (getDirectoryContents b) >>= \fs -> liftIO (migrationids b fs) >>=+  mapM (\p ->+         do downexists <- liftIO $ doesFileExist (b </> p <.> "down.sql")+            unless downexists (left $ "no down.sql for migration [" ++ p ++ "]")+            u <- liftIO . readFile $ b </> p <.> "up.sql"+            d <- liftIO . readFile $ b </> p <.> "down.sql"+            right (Migration (pack p) (pack u) (pack d) (Just $ b </> p <.> "up.sql") (Just $ b </> p <.> "down.sql")))++migrationids :: FilePath -> [FilePath] -> IO [String]+migrationids b ps =+  filterM (\p -> doesFileExist (b </> p)) ps >>= \files ->+    return (filter (\p -> takeExtensions p == ".up.sql" ) files) >>= \ups -> return (fmap dropExtensions ups)++readFile' :: FilePath -> IO String+readFile' p = withFile p ReadMode hGetContents++hGetContents' :: Handle -> IO String+hGetContents' h = hGetContents h >>= \s -> length s `seq` return s+

@@ -0,0 +1,37 @@+{-#LANGUAGE OverloadedStrings #-}+module Database.Migrate.PostgreSQL where++import Control.Exception (SomeException(..), handle)+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Either++import Data.Text hiding (filter, reverse)+import Data.String (IsString(..))++import Database.PostgreSQL.Simple+import Database.Migrate.Core++instance MigrateDatabase IO Connection where+  initialize c = void $ execute_ c "CREATE TABLE IF NOT EXISTS MIGRATION_INFO (MIGRATION VARCHAR(50) PRIMARY KEY)"+  runMigrations = runall+  getMigrations c = fmap (fmap fromOnly) (query_ c "SELECT MIGRATION FROM MIGRATION_INFO")++record :: Connection -> MigrationId -> IO ()+record conn mid = void $ execute conn "INSERT INTO MIGRATION_INFO VALUES (?)" (Only mid)++runall :: Connection -> (Migration -> Ddl) -> [Migration] -> MigrationResultT IO [MigrationId]+runall c f ms =+  liftIO (begin c) >>+    (foldM (\rs m ->+             EitherT $+               do e <- runEitherT (saferun c f m)+                  case e of+                    Left emsg -> rollback c >> (return . Left $ Context (reverse rs) (migration m) emsg True)+                    Right r -> return . Right $ r:rs) [] ms) >>= \result -> liftIO (commit c) >> return (reverse result)++saferun :: Connection -> (Migration -> Ddl) -> Migration -> EitherT Text IO MigrationId+saferun c f m = EitherT $ handle (\e -> return (Left (pack . show $ (e :: SomeException)))) (fmap Right $ run c f m)++run :: Connection -> (Migration -> Ddl) -> Migration -> IO MigrationId+run c f m = execute_ c (fromString . unpack $ f m) >> record c (migration m) >> return (migration m)