groundhog 0.4.0 → 0.4.0.1
raw patch · 5 files changed
+42/−26 lines, 5 files
Files
- Database/Groundhog.hs +1/−0
- Database/Groundhog/Core.hs +1/−1
- Database/Groundhog/Expression.hs +8/−0
- Database/Groundhog/Generic.hs +30/−23
- groundhog.cabal +2/−2
Database/Groundhog.hs view
@@ -24,6 +24,7 @@ , (=.) , (&&.), (||.) , (==.), (/=.), (<.), (<=.), (>.), (>=.)+ , isFieldNothing -- * Migration , createMigration , executeMigration
Database/Groundhog/Core.hs view
@@ -483,7 +483,7 @@ -- | Represents everything which can be put into a database. This data can be stored in multiple columns and tables. To get value of those columns we might need to access another table. That is why the result type is monadic. class PersistField a where- -- | Return name of the type. If it is polymorhic, the names of parameter types are separated with 'Database.Groundhog.Generic.delim' symbol+ -- | Return name of the type. If it is polymorphic, the names of parameter types are separated with 'Database.Groundhog.Generic.delim' symbol persistName :: a -> String -- | Convert a value into something which can be stored in a database column. -- Note that for complex datatypes it may insert them to return identifier
Database/Groundhog/Expression.hs view
@@ -17,6 +17,7 @@ , (=.) , (&&.), (||.) , (==.), (/=.), (<.), (<=.), (>.), (>=.) + , isFieldNothing ) where import Database.Groundhog.Core @@ -135,3 +136,10 @@ a <=. b = Compare Le (toExpr a) (toExpr b) a >. b = Compare Gt (toExpr a) (toExpr b) a >=. b = Compare Ge (toExpr a) (toExpr b) + +-- | This function more limited than (==.), but has better type inference. +-- If you want to compare your value to Nothing with @(==.)@ operator, you have to write the types explicitly @myExpr ==. (Nothing :: Maybe Int)@. +isFieldNothing :: (Expression db r f, FieldLike f db r (Maybe a), PrimitivePersistField (Maybe a), Unifiable f (Maybe a)) => f -> Cond db r +isFieldNothing a = a `eq` Nothing where + eq :: (Expression db r f, Expression db r a, FieldLike f db r a, Unifiable f a) => f -> a -> Cond db r + eq = (==.)
Database/Groundhog/Generic.hs view
@@ -7,6 +7,7 @@ createMigration , executeMigration , executeMigrationUnsafe+ , getQueries , runMigration , runMigrationUnsafe , printMigration@@ -66,41 +67,47 @@ import Data.List (partition, sortBy) import qualified Data.Map as Map -getCorrectMigrations :: NamedMigrations -> [(Bool, Int, String)]-getCorrectMigrations = either (error.unlines) id . mergeMigrations . Map.elems- -- | Produce the migrations but not execute them. Fails when an unsafe migration occurs. createMigration :: PersistBackend m => Migration m -> m NamedMigrations createMigration m = liftM snd $ runStateT m Map.empty +-- | Returns either a list of errors in migration or a list of queries+getQueries :: Bool -- ^ True - support unsafe queries+ -> SingleMigration -> Either [String] [String]+getQueries _ (Left errs) = Left errs+getQueries runUnsafe (Right migs) = (if runUnsafe || null unsafe+ then Right $ map (\(_, _, query) -> query) migs'+ else Left $+ [ "Database migration: manual intervention required."+ , "The following actions are considered unsafe:"+ ] ++ map (\(_, _, query) -> query) unsafe) where+ migs' = sortBy (compare `on` \(_, i, _) -> i) migs+ unsafe = filter (\(isUnsafe, _, _) -> isUnsafe) migs'++executeMigration' :: (PersistBackend m, MonadIO m) => Bool -> (String -> IO ()) -> NamedMigrations -> m ()+executeMigration' runUnsafe logger m = do+ let migs = getQueries runUnsafe $ mergeMigrations $ Map.elems m+ case migs of+ Left errs -> fail $ unlines errs+ Right qs -> mapM_ (executeMigrate logger) qs+ -- | Execute the migrations and log them. executeMigration :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> NamedMigrations -> m ()-executeMigration logger m = do- let migs = getCorrectMigrations m- let unsafe = filter (\(isUnsafe, _, _) -> isUnsafe) migs- if null unsafe- then mapM_ (\(_, _, query) -> executeMigrate logger query) $ sortBy (compare `on` \(_, i, _) -> i) migs- else error $ concat- [ "\n\nDatabase migration: manual intervention required.\n"- , "The following actions are considered unsafe:\n\n"- , unlines $ map (\(_, _, query) -> " " ++ query ++ ";") unsafe- ]+executeMigration = executeMigration' False -- | Execute migrations and log them. Executes the unsafe migrations without warnings executeMigrationUnsafe :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> NamedMigrations -> m ()-executeMigrationUnsafe logger = mapM_ (\(_, _, query) -> executeMigrate logger query) . getCorrectMigrations+executeMigrationUnsafe = executeMigration' True -- | Pretty print the migrations printMigration :: MonadIO m => NamedMigrations -> m ()-printMigration migs = liftIO $ do- let kv = Map.assocs migs- forM_ kv $ \(k, v) -> do- putStrLn $ "Datatype " ++ k ++ ":"- case v of- Left errors -> mapM_ (putStrLn . ("\tError:\t" ++)) errors- Right sqls -> do- let showSql (isUnsafe, _, sql) = (if isUnsafe then "Unsafe:\t" else "Safe:\t") ++ sql- mapM_ (putStrLn . ("\t" ++) . showSql) sqls+printMigration migs = liftIO $ forM_ (Map.assocs migs) $ \(k, v) -> do+ putStrLn $ "Datatype " ++ k ++ ":"+ case v of+ Left errors -> mapM_ (putStrLn . ("\tError:\t" ++)) errors+ Right sqls -> do+ let showSql (isUnsafe, _, sql) = (if isUnsafe then "Unsafe:\t" else "Safe:\t") ++ sql+ mapM_ (putStrLn . ("\t" ++) . showSql) sqls -- | Run migrations and log them. Fails when an unsafe migration occurs. runMigration :: (PersistBackend m, MonadIO m) => (String -> IO ()) -> Migration m -> m ()
groundhog.cabal view
@@ -1,5 +1,5 @@ name: groundhog-version: 0.4.0+version: 0.4.0.1 license: BSD3 license-file: LICENSE author: Boris Lykah <lykahb@gmail.com>@@ -7,7 +7,7 @@ synopsis: Type-safe datatype-database mapping library. description: This library maps your datatypes to a relational model, in a way similar to what ORM libraries do in OOP. The schema can be configured flexibly which makes integration with existing databases easy. Groundhog supports schema migrations, composite keys, advanced expressions in queries, and much more. See examples folder on GitHub. category: Database-stability: Non-stable+stability: Stable cabal-version: >= 1.6 build-type: Simple homepage: http://github.com/lykahb/groundhog