drifter 0.2 → 0.2.1

raw patch · 5 files changed

+34/−12 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog +2/−0
• drifter.cabal +1/−1
• src/Drifter.hs +7/−5
• src/Drifter/Graph.hs +6/−3
• test/Main.hs +18/−3

@@ -1,3 +1,5 @@+# 0.2.1+* Fix bug where changeSequence would drop the head of the list. # 0.2 * Drop direct support for postgresql. That can be found in the drifter-postgresql package. * Just export a single module, Drifter

@@ -1,5 +1,5 @@ name:                drifter-version:             0.2+version:             0.2.1 synopsis:            Simple schema management for arbitrary databases. description:         Simple support for migrating database schemas, which allows                      haskell functions to be run as a part of the migration.

@@ -14,10 +14,12 @@     ) where  -import Data.List--import Drifter.Graph-import Drifter.Types+-------------------------------------------------------------------------------+import           Data.List+-------------------------------------------------------------------------------+import           Drifter.Graph+import           Drifter.Types+-------------------------------------------------------------------------------   -- | This is a helper for the common case of where you just want@@ -25,7 +27,7 @@ -- and set their dependencies to run in the given sequence. changeSequence :: [Change a] -> [Change a] changeSequence [] = []-changeSequence (x:xs) = reverse $ snd $ foldl' go (x, []) xs+changeSequence (x:xs) = reverse $ snd $ foldl' go (x, [x]) xs   where     go :: (Change a, [Change a]) -> Change a -> (Change a, [Change a])     go (lastChange, xs') c =

@@ -4,14 +4,17 @@     , migrate     ) where -import           Control.Applicative+-------------------------------------------------------------------------------+import           Control.Applicative  as A import           Control.Monad import           Data.Graph.Inductive (Edge, Gr, UEdge, mkGraph, topsort') import qualified Data.Map.Strict      as Map import           Data.Maybe-+------------------------------------------------------------------------------- import           Drifter.Types+------------------------------------------------------------------------------- + labUEdges :: [Edge] -> [UEdge] labUEdges = map (\(a, b) -> (a, b, ())) @@ -53,7 +56,7 @@   fmap f = EitherT . liftM (fmap f) . runEitherT   {-# INLINE fmap #-} -instance Monad m => Applicative (EitherT e m) where+instance Monad m => A.Applicative (EitherT e m) where   pure a  = EitherT $ return (Right a)   {-# INLINE pure #-}   EitherT f <*> EitherT v = EitherT $ f >>= \mf -> case mf of

@@ -9,7 +9,8 @@     ( main     ) where -import           Control.Applicative+-------------------------------------------------------------------------------+import           Control.Applicative   as A import           Data.IORef import           Data.List import           Data.Text             (Text)@@ -17,8 +18,9 @@ import           Test.Tasty import           Test.Tasty.HUnit import           Test.Tasty.QuickCheck-+------------------------------------------------------------------------------- import           Drifter+-------------------------------------------------------------------------------   main :: IO ()@@ -29,8 +31,21 @@     [       graphTests     , typesTests+    , changeSequenceTests     ] +-------------------------------------------------------------------------------+changeSequenceTests :: TestTree+changeSequenceTests = testGroup "changeSequence"+  [+    testProperty "preserves list members" $ \((Blind cs) :: Blind [Change TestDB]) ->+      let cnames = changeName <$> cs+          cnames' = changeName <$> changeSequence cs+      in cnames === cnames'+  ]+++------------------------------------------------------------------------------- graphTests :: TestTree graphTests = testGroup "Drifter.Graph"     [@@ -101,7 +116,7 @@ newtype UniqueChanges = UniqueChanges [Change TestDB] deriving (Show)  instance Arbitrary UniqueChanges  where-  arbitrary = UniqueChanges <$> arbitrary `suchThat` uniqueNames+  arbitrary = UniqueChanges A.<$> arbitrary `suchThat` uniqueNames     where       uniqueNames cs = let names = map changeName cs                        in nub names == names