Merge pull request jtdaugherty#35 from GetShopTV/viviag_patch

Support .yml extension in migration names, add Travis config

.travis.yml

@@ -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

MOO.TXT

@@ -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

dbmigrations.cabal

@@ -81,6 +81,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,
@@ -91,8 +92,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
@@ -102,10 +105,6 @@ Library
           Moo.Core
           Moo.Main
 
-  Other-Modules:
-          Database.Schema.Migrations.CycleDetection
-          Database.Schema.Migrations.Filesystem.Serialize
-
 test-suite dbmigrations-tests
   default-language: Haskell2010
   type: exitcode-stdio-1.0
@@ -121,6 +120,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,
@@ -139,7 +139,6 @@ test-suite dbmigrations-tests
     FilesystemTest
     MigrationsTest
     StoreTest
-    TestDriver
     InMemoryStore
     LinearMigrationsTest
     ConfigurationTest
@@ -150,8 +149,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

src/Database/Schema/Migrations.hs

@@ -9,6 +9,7 @@ module Database.Schema.Migrations
     )
 where
 
+import Data.Text ( Text )
 import qualified Data.Set as Set
 import Data.Maybe ( catMaybes )
 
@@ -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

src/Database/Schema/Migrations/Backend.hs

@@ -1,16 +1,19 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Database.Schema.Migrations.Backend
     ( Backend(..)
     , rootMigrationName
     )
 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
@@ -55,7 +58,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.
 
@@ -71,4 +74,4 @@ data Backend =
             }
 
 instance Show Backend where
-   show _ = show "dbmigrations backend"
+   show _ = "dbmigrations backend"

src/Database/Schema/Migrations/Backend/HDBC.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Database.Schema.Migrations.Backend.HDBC
     ( hdbcBackend
     )
@@ -22,22 +23,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
@@ -49,22 +53,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

src/Database/Schema/Migrations/Dependencies.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeSynonymInstances, OverloadedStrings #-}
 -- |This module types and functions for representing a dependency
 -- graph of arbitrary objects and functions for querying such graphs
 -- to get dependency and reverse dependency information.
@@ -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 )
 
@@ -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.
                             }
 
@@ -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 [] = []
@@ -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