Skip to content
This repository has been archived by the owner on Jan 30, 2024. It is now read-only.

Support .yml extension in migration names, add Travis config #35

Merged
merged 10 commits into from
Dec 3, 2018
16 changes: 16 additions & 0 deletions .travis.yml
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
# Do not choose a language; we provide our own build tools.
language: generic

before_install:
- wget https://www.haskell.org/platform/download/8.4.3/haskell-platform-8.4.3-unknown-posix--full-x86_64.tar.gz
- tar xf haskell-platform-8.4.3-unknown-posix--full-x86_64.tar.gz
- sudo ./install-haskell-platform.sh
- cabal --version

install:
- cabal update
- cabal install --enable-tests

script:
- cabal test
- cabal haddock
6 changes: 4 additions & 2 deletions MOO.TXT
Original file line number Diff line number Diff line change
Expand Up @@ -74,10 +74,12 @@ Getting started
Confirm: create migration 'hello-world'
(No dependencies)
Are you sure? (yn): y
Migration created successfully: ".../hello-world.txt"
Migration created successfully: ".../hello-world.yml"

New migration will be stored with .yml extension. Older .txt migrations are supported.

6. Edit the migration you created. In this case, moo created a file
$DBM_MIGRATION_STORE/hello_world.txt that looks like this:
$DBM_MIGRATION_STORE/hello_world.yml that looks like this:

Description: (Description here.)
Created: 2015-02-18 00:50:12.041176 UTC
Expand Down
15 changes: 8 additions & 7 deletions dbmigrations.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,7 @@ Source-Repository head

Library
default-language: Haskell2010
default-extensions: OverloadedStrings
if impl(ghc >= 6.12.0)
ghc-options: -Wall -fwarn-tabs -funbox-strict-fields
-fno-warn-unused-do-bind
Expand All @@ -81,6 +82,7 @@ Library
template-haskell,
yaml-light >= 0.1,
bytestring >= 0.9,
string-conversions >= 0.4,
text >= 0.11,
configurator >= 0.2,
split >= 0.2.2,
Expand All @@ -91,8 +93,10 @@ Library
Database.Schema.Migrations
Database.Schema.Migrations.Backend
Database.Schema.Migrations.Backend.HDBC
Database.Schema.Migrations.CycleDetection
Database.Schema.Migrations.Dependencies
Database.Schema.Migrations.Filesystem
Database.Schema.Migrations.Filesystem.Serialize
Database.Schema.Migrations.Migration
Database.Schema.Migrations.Store
Database.Schema.Migrations.Test.BackendTest
Expand All @@ -102,12 +106,9 @@ Library
Moo.Core
Moo.Main

Other-Modules:
Database.Schema.Migrations.CycleDetection
Database.Schema.Migrations.Filesystem.Serialize

test-suite dbmigrations-tests
default-language: Haskell2010
default-extensions: OverloadedStrings
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can you please move this to the relevant modules with explicit pragmas?

type: exitcode-stdio-1.0
Build-Depends:
base >= 4 && < 5,
Expand All @@ -121,6 +122,7 @@ test-suite dbmigrations-tests
template-haskell,
yaml-light >= 0.1,
bytestring >= 0.9,
string-conversions >= 0.4,
MissingH,
HDBC >= 2.2.1,
HUnit >= 1.2,
Expand All @@ -139,7 +141,6 @@ test-suite dbmigrations-tests
FilesystemTest
MigrationsTest
StoreTest
TestDriver
InMemoryStore
LinearMigrationsTest
ConfigurationTest
Expand All @@ -150,8 +151,8 @@ test-suite dbmigrations-tests
else
ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields

Hs-Source-Dirs: src,test
Main-is: TestDriver.hs
Hs-Source-Dirs: test
Main-is: Main.hs

Executable moo
default-language: Haskell2010
Expand Down
3 changes: 2 additions & 1 deletion src/Database/Schema/Migrations.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@ module Database.Schema.Migrations
)
where

import Data.Text ( Text )
import qualified Data.Set as Set
import Data.Maybe ( catMaybes )

Expand All @@ -25,7 +26,7 @@ import Database.Schema.Migrations.Migration
-- |Given a 'B.Backend' and a 'S.MigrationMap', query the backend and
-- return a list of migration names which are available in the
-- 'S.MigrationMap' but which are not installed in the 'B.Backend'.
missingMigrations :: B.Backend -> S.StoreData -> IO [String]
missingMigrations :: B.Backend -> S.StoreData -> IO [Text]
missingMigrations backend storeData = do
let storeMigrationNames = map mId $ S.storeMigrations storeData
backendMigrations <- B.getMigrations backend
Expand Down
8 changes: 5 additions & 3 deletions src/Database/Schema/Migrations/Backend.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,13 +4,15 @@ module Database.Schema.Migrations.Backend
)
where

import Data.Text ( Text )

import Database.Schema.Migrations.Migration
( Migration(..) )

-- |Backend instances should use this as the name of the migration
-- returned by getBootstrapMigration; this migration is special
-- because it cannot be reverted.
rootMigrationName :: String
rootMigrationName :: Text
rootMigrationName = "root"

-- |A Backend represents a database engine backend such as MySQL or
Expand Down Expand Up @@ -55,7 +57,7 @@ data Backend =
-- does not supply a revert instruction, this has no effect
-- other than bookkeeping.

, getMigrations :: IO [String]
, getMigrations :: IO [Text]
-- ^ Returns a list of installed migration names from the
-- backend.

Expand All @@ -71,4 +73,4 @@ data Backend =
}

instance Show Backend where
show _ = show "dbmigrations backend"
show _ = "dbmigrations backend"
25 changes: 14 additions & 11 deletions src/Database/Schema/Migrations/Backend/HDBC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,22 +22,25 @@ import Database.Schema.Migrations.Migration
, newMigration
)

import Data.Text ( Text )
import Data.String.Conversions ( cs, (<>) )

import Control.Applicative ( (<$>) )
import Data.Time.Clock (getCurrentTime)

migrationTableName :: String
migrationTableName :: Text
migrationTableName = "installed_migrations"

createSql :: String
createSql = "CREATE TABLE " ++ migrationTableName ++ " (migration_id TEXT)"
createSql :: Text
createSql = "CREATE TABLE " <> migrationTableName <> " (migration_id TEXT)"

revertSql :: String
revertSql = "DROP TABLE " ++ migrationTableName
revertSql :: Text
revertSql = "DROP TABLE " <> migrationTableName

-- |General Backend constructor for all HDBC connection implementations.
hdbcBackend :: (IConnection conn) => conn -> Backend
hdbcBackend conn =
Backend { isBootstrapped = elem migrationTableName <$> getTables conn
Backend { isBootstrapped = elem (cs migrationTableName) <$> getTables conn
, getBootstrapMigration =
do
ts <- getCurrentTime
Expand All @@ -49,22 +52,22 @@ hdbcBackend conn =
}

, applyMigration = \m -> do
runRaw conn (mApply m)
run conn ("INSERT INTO " ++ migrationTableName ++
runRaw conn (cs $ mApply m)
_ <- run conn (cs $ "INSERT INTO " <> migrationTableName <>
" (migration_id) VALUES (?)") [toSql $ mId m]
return ()

, revertMigration = \m -> do
case mRevert m of
Nothing -> return ()
Just query -> runRaw conn query
Just query -> runRaw conn (cs query)
-- Remove migration from installed_migrations in either case.
run conn ("DELETE FROM " ++ migrationTableName ++
_ <- run conn (cs $ "DELETE FROM " <> migrationTableName <>
" WHERE migration_id = ?") [toSql $ mId m]
return ()

, getMigrations = do
results <- quickQuery' conn ("SELECT migration_id FROM " ++ migrationTableName) []
results <- quickQuery' conn (cs $ "SELECT migration_id FROM " <> migrationTableName) []
return $ map (fromSql . head) results

, commitBackend = commit conn
Expand Down
22 changes: 12 additions & 10 deletions src/Database/Schema/Migrations/Dependencies.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,9 @@ module Database.Schema.Migrations.Dependencies
)
where

import Data.Text ( Text )
import Data.Maybe ( fromJust )
import Data.Monoid ( (<>) )
import Data.Graph.Inductive.Graph ( Graph(..), nodes, edges, Node, suc, pre, lab )
import Data.Graph.Inductive.PatriciaTree ( Gr )

Expand All @@ -21,24 +23,24 @@ import Database.Schema.Migrations.CycleDetection ( hasCycle )
-- and a list of other objects upon which they depend.
class (Eq a, Ord a) => Dependable a where
-- |The identifiers of the objects on which @a@ depends.
depsOf :: a -> [String]
depsOf :: a -> [Text]
-- |The identifier of a 'Dependable' object.
depId :: a -> String
depId :: a -> Text

-- |A 'DependencyGraph' represents a collection of objects together
-- with a graph of their dependency relationships. This is intended
-- to be used with instances of 'Dependable'.
data DependencyGraph a = DG { depGraphObjectMap :: [(a, Int)]
-- ^ A mapping of 'Dependable' objects to
-- their graph vertex indices.
, depGraphNameMap :: [(String, Int)]
, depGraphNameMap :: [(Text, Int)]
-- ^ A mapping of 'Dependable' object
-- identifiers to their graph vertex
-- indices.
, depGraph :: Gr String String
, depGraph :: Gr Text Text
-- ^ A directed 'Gr' (graph) of the
-- 'Dependable' objects' dependency
-- relationships, with 'String' vertex and
-- relationships, with 'Text' vertex and
-- edge labels.
}

Expand All @@ -65,14 +67,14 @@ mkDepGraph objects = if hasCycle theGraph
n = [ (fromJust $ lookup o ids, depId o) | o <- objects ]
e = [ ( fromJust $ lookup o ids
, fromJust $ lookup d ids
, depId o ++ " -> " ++ depId d) | o <- objects, d <- depsOf' o ]
, depId o <> " -> " <> depId d) | o <- objects, d <- depsOf' o ]
depsOf' o = map (\i -> fromJust $ lookup i objMap) $ depsOf o

objMap = map (\o -> (depId o, o)) objects
ids = zip objects [1..]
names = map (\(o,i) -> (depId o, i)) ids

type NextNodesFunc = Gr String String -> Node -> [Node]
type NextNodesFunc = Gr Text Text -> Node -> [Node]

cleanLDups :: (Eq a) => [a] -> [a]
cleanLDups [] = []
Expand All @@ -82,16 +84,16 @@ cleanLDups (e:es) = if e `elem` es then (cleanLDups es) else (e:cleanLDups es)
-- |Given a dependency graph and an ID, return the IDs of objects that
-- the object depends on. IDs are returned with least direct
-- dependencies first (i.e., the apply order).
dependencies :: (Dependable d) => DependencyGraph d -> String -> [String]
dependencies :: (Dependable d) => DependencyGraph d -> Text -> [Text]
dependencies g m = reverse $ cleanLDups $ dependenciesWith suc g m

-- |Given a dependency graph and an ID, return the IDs of objects that
-- depend on it. IDs are returned with least direct reverse
-- dependencies first (i.e., the revert order).
reverseDependencies :: (Dependable d) => DependencyGraph d -> String -> [String]
reverseDependencies :: (Dependable d) => DependencyGraph d -> Text -> [Text]
reverseDependencies g m = reverse $ cleanLDups $ dependenciesWith pre g m

dependenciesWith :: (Dependable d) => NextNodesFunc -> DependencyGraph d -> String -> [String]
dependenciesWith :: (Dependable d) => NextNodesFunc -> DependencyGraph d -> Text -> [Text]
dependenciesWith nextNodes dg@(DG _ nMap theGraph) name =
let lookupId = fromJust $ lookup name nMap
depNodes = nextNodes theGraph lookupId
Expand Down
Loading