refurb 0.2.2.0 → 0.2.3.0
raw patch · 12 files changed
+110/−19 lines, 12 filesdep +exceptionsdep +monad-controldep +these-lens
Dependencies added: exceptions, monad-control, these-lens, transformers-base
Files
- refurb.cabal +26/−14
- src/Refurb.hs +5/−0
- src/Refurb/Cli.hs +1/−0
- src/Refurb/MigrationUtils.hs +11/−0
- src/Refurb/Run/Backup.hs +5/−0
- src/Refurb/Run/Info.hs +12/−0
- src/Refurb/Run/Internal.hs +8/−1
- src/Refurb/Run/Migrate.hs +13/−3
- src/Refurb/Store.hs +14/−1
- src/Refurb/Types.hs +10/−0
- test/Main.hs +2/−0
- test/MigrationUtilsSpec.hs +3/−0
refurb.cabal view
@@ -1,35 +1,39 @@--- This file has been generated from package.yaml by hpack version 0.17.0.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack+--+-- hash: 303cc00ec1aa1ac86c703c9836382d92da8bacf61b4c4bbb124b5ba6f9343df8 name: refurb-version: 0.2.2.0+version: 0.2.3.0 synopsis: Tools for maintaining a database description: Tools for maintaining a database category: Database-homepage: https://github.com/ConferHealth/refurb#readme-maintainer: oss@confer.care-copyright: 2017 Confer Health, Inc.+homepage: https://github.com/ConferOpenSource/refurb#readme+maintainer: oss@vitalbio.com+copyright: 2017 Confer Health, Inc., 2020 Vital Biosciences license: BSD3 license-file: LICENSE build-type: Simple-cabal-version: >= 1.10 library hs-source-dirs: src- default-extensions: Arrows ConstraintKinds DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PatternSynonyms QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TypeApplications TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall -O2 build-depends:- base >= 4.7 && < 5- , ansi-wl-pprint+ ansi-wl-pprint+ , base >=4.7 && <5 , bytestring , classy-prelude , composite-base , composite-opaleye , dlist+ , exceptions , fast-logger , lens+ , monad-control , monad-logger , old-locale , opaleye@@ -40,7 +44,9 @@ , template-haskell , text , these+ , these-lens , thyme+ , transformers-base , vector-space exposed-modules: Refurb@@ -52,6 +58,8 @@ Refurb.Run.Migrate Refurb.Store Refurb.Types+ other-modules:+ Paths_refurb default-language: Haskell2010 test-suite refurb-test@@ -59,18 +67,20 @@ main-is: Main.hs hs-source-dirs: test- default-extensions: Arrows ConstraintKinds DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PatternSynonyms QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TypeApplications TypeFamilies TypeOperators ViewPatterns ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N -fno-warn-orphans build-depends:- base >= 4.7 && < 5- , ansi-wl-pprint+ ansi-wl-pprint+ , base >=4.7 && <5 , bytestring , classy-prelude , composite-base , composite-opaleye , dlist+ , exceptions , fast-logger+ , hspec , lens+ , monad-control , monad-logger , old-locale , opaleye@@ -78,13 +88,15 @@ , postgresql-simple , process , product-profunctors+ , refurb , template-haskell , text , these+ , these-lens , thyme+ , transformers-base , vector-space- , refurb- , hspec other-modules: MigrationUtilsSpec+ Paths_refurb default-language: Haskell2010
src/Refurb.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} -- |Top level module of Refurb along which re-exports the library portion of Refurb ('Refurb.Types' and 'Refurb.MigrationUtils') module Refurb ( refurbMain@@ -6,6 +10,7 @@ ) where import ClassyPrelude+import Control.Monad.Base (liftBase) import Control.Monad.Logger (LogLevel(LevelDebug), filterLogger, logDebug, runStdoutLoggingT) import qualified Database.PostgreSQL.Simple as PG import qualified Options.Applicative as OA
src/Refurb/Cli.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE NoImplicitPrelude #-} -- |Module with @optparse-applicative@ parsers for and datatypes to represent the command line arguments. module Refurb.Cli where
src/Refurb/MigrationUtils.hs view
@@ -1,7 +1,13 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-} -- |Utilities for writing migrations. module Refurb.MigrationUtils where import ClassyPrelude+import Control.Monad.Base (liftBase) import Control.Monad.Logger (logDebug) import Data.Profunctor.Product.Default (Default) import qualified Data.Text as T@@ -162,3 +168,8 @@ doesTableExist :: MonadMigration m => Text -> Text -> m Bool doesTableExist schema table = not . (null :: [PG.Only Int] -> Bool) <$> query "select 1 from information_schema.tables where table_schema = ? and table_name = ?" (schema, table)++-- |Check if a column exists in a schema on a table using the @information_schema@ views.+doesColumnExist :: MonadMigration m => Text -> Text -> Text -> m Bool+doesColumnExist schema table column =+ not . (null :: [PG.Only Int] -> Bool) <$> query "select 1 from information_schema.columns where table_schema = ? and table_name = ? and column_name = ?" (schema, table, column)
src/Refurb/Run/Backup.hs view
@@ -1,6 +1,11 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} module Refurb.Run.Backup where import ClassyPrelude+import Control.Monad.Base (liftBase) import Control.Monad.Logger (logInfo, logError) import Refurb.Run.Internal (MonadRefurb, contextDbConnInfo) import Refurb.Types (ConnInfo(ConnInfo), connDbName, connUser, connHost, connPort, connPassword)
src/Refurb/Run/Info.hs view
@@ -1,3 +1,10 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ViewPatterns #-} module Refurb.Run.Info where import ClassyPrelude@@ -5,7 +12,12 @@ import Control.Arrow (returnA) import Control.Lens (Getting, _Wrapped, each, preview, to, view) import Data.Monoid (First)+#if MIN_VERSION_these(1,0,0)+import Data.These (These(This, That, These))+import Data.These.Lens (there)+#else import Data.These (These(This, That, These), there)+#endif import Data.Thyme.Clock (NominalDiffTime, fromSeconds) import Data.Thyme.Format.Human (humanTimeDiff) import Opaleye ((.==), constant, restrict)
src/Refurb/Run/Internal.hs view
@@ -1,8 +1,16 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} -- |Module containing shared types and functions used for implementing the various commands. module Refurb.Run.Internal where import ClassyPrelude+import Control.Monad.Base (liftBase)+import Control.Monad.Catch (MonadMask) import Control.Monad.Logger (MonadLogger, MonadLoggerIO)+import Control.Monad.Trans.Control (MonadBaseControl) import qualified Database.PostgreSQL.Simple as PG import Refurb.Cli (Opts, colorize) import Refurb.Store (MigrationResult(MigrationSuccess, MigrationFailure))@@ -44,4 +52,3 @@ migrationResultDoc = \ case MigrationSuccess -> green (text "success") MigrationFailure -> red (text "failure")-
src/Refurb/Run/Migrate.hs view
@@ -1,13 +1,24 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} module Refurb.Run.Migrate where import ClassyPrelude hiding ((</>), defaultTimeLocale, getCurrentTime, formatTime) import Composite.Record (Record, pattern (:*:), pattern RNil) import Control.Arrow (returnA)+import Control.Monad.Base (liftBase) import Control.Monad.Logger (askLoggerIO, runLoggingT) import Control.Lens (each, toListOf, view) import Data.AffineSpace ((.-.)) import qualified Data.DList as DL+#if MIN_VERSION_these(1,0,0)+import Data.These.Lens (_This)+#else import Data.These (_This)+#endif import Data.Thyme.Clock (NominalDiffTime, getCurrentTime, toSeconds) import Data.Thyme.Format (formatTime) import Data.Thyme.Format.Human (humanTimeDiff)@@ -33,7 +44,7 @@ -- |Implement the @migrate@ command by verifying that seed data is only applied to non-production databases, reading the migration status, and determining -- from that status which migrations to apply. If the user requested execution of migrations, delegate to 'applyMigrations' to actually do the work.-migrate :: MonadRefurb m => GoNoGo -> Maybe PreMigrationBackup -> InstallSeedData -> m ()+migrate :: (MonadUnliftIO m, MonadRefurb m) => GoNoGo -> Maybe PreMigrationBackup -> InstallSeedData -> m () migrate (GoNoGo isGo) backupMay (InstallSeedData shouldInstallSeedData) = do disp <- optionallyColoredM dbConn <- asks contextDbConn@@ -58,7 +69,7 @@ -- |Given a pre-vetted list of 'Migration' structures to apply to the database, iterate through them and run their check actions (if any) followed by -- execution actions with log output captured.-applyMigrations :: MonadRefurb m => [Migration] -> m ()+applyMigrations :: (MonadUnliftIO m, MonadRefurb m) => [Migration] -> m () applyMigrations migrations = do disp <- optionallyColoredM dbConn <- asks contextDbConn@@ -119,4 +130,3 @@ nowLogString = do now <- getCurrentTime pure . toLogStr $ formatTime defaultTimeLocale "%Y-%m-%d %T%Q" now-
src/Refurb/Store.hs view
@@ -1,3 +1,14 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-} -- |Module containing definition of and functions for maintaining the in-database state storage for Refurb. module Refurb.Store where @@ -8,7 +19,10 @@ import Composite.TH (withLensesAndProxies) import Control.Arrow (returnA) import Control.Lens (view)+import Control.Monad.Base (liftBase)+import Control.Monad.Catch (MonadMask) import Control.Monad.Logger (MonadLogger, logDebug)+import Control.Monad.Trans.Control (MonadBaseControl) import Data.These (These(This, These, That)) import qualified Database.PostgreSQL.Simple as PG import Opaleye (Column, PGBool, PGInt4, PGFloat8, PGText, PGTimestamptz, QueryArr, Table(TableWithSchema), asc, orderBy, queryTable, runQuery)@@ -135,4 +149,3 @@ (aligned, extra) = foldr alignMigration ([], migrationLogByKey) migrations pure $ map That (toList extra) ++ aligned-
src/Refurb/Types.hs view
@@ -1,3 +1,11 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-} -- |Module containing externally useful types for Refurb, most notably the 'Migration' type. module Refurb.Types ( ConnInfo(..)@@ -10,7 +18,9 @@ import ClassyPrelude import Control.Lens.TH (makeLenses)+import Control.Monad.Catch (MonadMask) import Control.Monad.Logger (MonadLogger)+import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.ByteString.Char8 as BSC8 import Data.Word (Word16) import qualified Database.PostgreSQL.Simple as PG
test/Main.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE NoImplicitPrelude #-}+module Main where import ClassyPrelude import MigrationUtilsSpec (migrationUtilsSuite) import Test.Hspec (hspec)
test/MigrationUtilsSpec.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} module MigrationUtilsSpec where import ClassyPrelude