packages feed

moto 0.0.3 → 0.0.4

raw patch · 9 files changed

+213/−86 lines, 9 filesdep +pipes-aesonsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: pipes-aeson

API changes (from Hackage documentation)

+ Moto: dummyBackup :: Backup ()
+ Moto: dummyStore :: Store ()
+ Moto.File: instance GHC.Exception.Type.Exception Moto.File.Err_JsonStoreLoad
+ Moto.File: instance GHC.Show.Show Moto.File.Err_JsonStoreLoad
+ Moto.File: jsonStore :: (FromJSON x, ToJSON x) => FilePath -> Store x
- Moto.File: withRegistry :: (MonadIO m, MonadMask m) => FilePath -> (Registry -> m a) -> m a
+ Moto.File: withRegistry :: (MonadIO m, MonadMask m) => Df1 -> FilePath -> (Registry -> m a) -> m a
- Moto.Registry: RegistryConf :: String -> (String -> Either String r) -> (forall a. r -> (Registry -> IO a) -> IO a) -> RegistryConf
+ Moto.Registry: RegistryConf :: String -> (String -> Either String r) -> (forall a. Df1 -> r -> (Registry -> IO a) -> IO a) -> RegistryConf
- Moto.Registry: [registryConf_with] :: RegistryConf -> forall a. r -> (Registry -> IO a) -> IO a
+ Moto.Registry: [registryConf_with] :: RegistryConf -> forall a. Df1 -> r -> (Registry -> IO a) -> IO a

Files

CHANGELOG.md view
@@ -1,3 +1,27 @@+# Version 0.0.4++* _COMPILER ASSISTED BREAKING CHANGE._ `registryConf_with` now takes a+  `Di` as extra argument.++* _BREAKING CHANGE._ `Moto.File` registry now now takes `/foo/bar` on the+  command line, rather than `file:///foo/bar`.++* Added `Moto.File.jsonStore`. See issue #11.++* Added `Moto.dummyStore`. See issue #3.++* Added `Moto.dummyBackup`. See issue #7.++* Added `--unsafe-commit` and `--unsafe-abort` switches to the `clean` CLI.+  These can be used to force the cleanup of a dirty migration registry without+  actually running any clean-up code, which can be useful in case of manual+  recovery. See issue #13.++* Made compatible with `di-df1` version `1.2`.++* Improved exception logging.++ # Version 0.0.3  * Haddocks and Hackage choke on internal Cabal libraries, so we remove the
− Setup.hs 
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
lib/Moto.hs view
@@ -76,7 +76,9 @@  , I.Mig(..)  , I.Store(..)  , I.mapStore+ , dummyStore  , I.Backup(..)+ , dummyBackup  , I.Change(..)  , I.Direction(..)  , I.direction@@ -96,6 +98,18 @@  import qualified Moto.Internal as I import qualified Moto.Internal.Cli as IC++-- | A 'I.Store' that does nothing and always succeeds.+dummyStore :: I.Store ()+dummyStore = I.Store+  { I.store_delete = \_di _mId -> pure ()+  , I.store_save = \_di _mId () -> pure ()+  , I.store_load = \_di _mId k -> k ()+  }++-- | A 'I.Backup' that does nothing and always succeeds.+dummyBackup :: I.Backup ()+dummyBackup = I.Backup (\_di k -> k ())  {- $example
lib/Moto/File.hs view
@@ -16,12 +16,14 @@    registryConf  , withRegistry - , -- * Store-   store+   -- * Store+ , store+ , jsonStore  ) where  import Control.Applicative (empty) import qualified Control.Exception.Safe as Ex+import Control.Monad (when) import qualified Control.Monad.Trans.State.Strict as S import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans (lift)@@ -31,10 +33,15 @@ import qualified Data.ByteString.Builder as BB import qualified Data.Char as Char import qualified Data.Text as T+import Data.Maybe (isJust)+import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL+import qualified Di.Df1 as Di import GHC.IO.Handle as IO (LockMode(ExclusiveLock), hLock) import qualified Pipes as P+import qualified Pipes.Aeson as PAe+import qualified Pipes.Aeson.Unchecked as PAeu import qualified Pipes.Attoparsec as Pa import qualified Pipes.ByteString as Pb import qualified System.Directory as Dir@@ -52,23 +59,20 @@ -- filesystem using 'withRegistry'. registryConf :: IC.RegistryConf registryConf = IC.RegistryConf-  { IC.registryConf_help =-      "File where registry file is stored. E.g., \-      \file:///var/db/migrations"+  { IC.registryConf_with = withRegistry+  , IC.registryConf_help =+      "File where registry file is stored. E.g., /var/db/migrations"   , IC.registryConf_parse = \case-      'f':'i':'l':'e':':':'/':'/':xs -> case xs of-          ""  -> Left "Invalid file path"-          "/" -> Left "Invaild file path"-          _   -> Right xs-      _ -> Left "Invalid file path"-  , IC.registryConf_with = withRegistry+      fp@('/':_) -> pure fp+      _ -> Left "File path must be absolute."   }  -- | Obtain a 'I.Registry' backed by an append-only file storage, using @moto@'s -- own file format. withRegistry   :: (MonadIO m, Ex.MonadMask m)-  => IO.FilePath+  => Di.Df1+  -> IO.FilePath   -- ^ File where to store the registry logs.   --   -- An exclusive lock will be set on the this file (see 'IO.hLock'), which will@@ -76,8 +80,8 @@   -- interact with this file while this program is running.   -> (I.Registry -> m a)   -> m a-withRegistry fp =-  withRegistryCustom renderLogLine parseLogLine fp+withRegistry di0 fp k =+  withRegistryCustom renderLogLine parseLogLine di0 fp k  -- | Obtain a 'I.Registry' backed by an append-only file storage as described by -- 'R.newAppendOnlyRegistry'.@@ -89,6 +93,7 @@   -> A8.Parser I.Log   -- ^ Parse a single 'I.Log'. Be sure to consume and discard any trailing   -- newline or similar separating one rendered 'I.Log' entry from the next.+  -> Di.Df1   -> IO.FilePath   -- ^ File where to store the registry logs.   --@@ -97,14 +102,20 @@   -- interact with this file while this program is running.   -> (I.Registry -> m a)   -> m a-withRegistryCustom render parser fp k = do+withRegistryCustom render parser di0 fp k = do+  let di1 = Di.attr "file" fp di0   Ex.bracket     (liftIO $ do+       Di.debug_ di1 "Opening registry file..."        h <- IO.openBinaryFile fp IO.ReadWriteMode+       Di.debug_ di1 "Acquiring exclusive file lock..."        IO.hLock h IO.ExclusiveLock        pure h)-    (liftIO . IO.hClose)+    (\h -> liftIO $ do+       Di.debug_ di1 "Closing registry file..."+       IO.hClose h)     (\h -> k =<< liftIO (do+       Di.debug_ di1 "Loading state from registry..."        state0 <- do           ea <- flip S.runStateT I.emptyState $ P.runEffect $ do              P.for (Pa.parsed parser (Pb.fromHandle h)) $ \l -> do@@ -218,3 +229,31 @@              \To backup these backups, it is sufficient to copy the contents\n\              \of this directory, preserving the file names." -}++-- | Like 'store', but serializes data in a JSON format.+--+-- WARNING: This holds all of @x@ in memory, so avoid using 'jsonStore' if your+-- data is too large.+jsonStore :: (Ae.FromJSON x, Ae.ToJSON x) => FilePath -> I.Store x+jsonStore fp =+  let s0 = store fp+  in I.Store+     { I.store_delete = I.store_delete s0+     , I.store_save = \di mId x -> do+         I.store_save s0 di mId (PAeu.encode x)+     , I.store_load = \di mId k -> do+         I.store_load s0 di mId $ \p0 -> do+           yea <- S.evalStateT PAeu.decode p0+           case yea of+             Nothing -> Ex.throwM Err_JsonStoreLoad_NoInput+             Just (Left e) -> Ex.throwM (Err_JsonStoreLoad_Decoding e)+             Just (Right x) -> k x+     }++-- | And error from 'jsonStore''s 'I.store_load'.+data Err_JsonStoreLoad+  = Err_JsonStoreLoad_NoInput+  | Err_JsonStoreLoad_Decoding PAe.DecodingError+  deriving (Show)+instance Ex.Exception Err_JsonStoreLoad+
lib/Moto/Internal.hs view
@@ -59,6 +59,8 @@  -- * Registry  , Registry(..)  , cleanRegistry+ , unsafeCleanRegistry+ , OnDirty(..)   -- * State  , State@@ -346,9 +348,9 @@ pimpBackup :: Backup x -> Backup x pimpBackup (Backup f) = Backup $ \di0 k -> do   let di1 = Di.push "backup" di0-  Di.debug di1 "Running..."+  Di.debug_ di1 "Running..."   r <- logException di1 (f di1 k)-  Di.debug di1 "Ran."+  Di.debug_ di1 "Ran."   -- Bonus track: Run GC to ensure we don't keep @x@ in memory.   System.Mem.performMajorGC   pure r@@ -426,22 +428,22 @@ pimpStore sto = sto   { store_save = \di0 mId x -> do      let di1 = Di.push "save" di0-     Di.debug di1 "Saving recovery data..."+     Di.debug_ di1 "Saving recovery data..."      logException di1 (store_save sto di1 mId x)-     Di.debug di1 "Saved."+     Di.debug_ di1 "Saved."   , store_load = \di0 mId k -> do      let di1 = Di.push "load" di0-     Di.debug di1 "Loading recovery data..."+     Di.debug_ di1 "Loading recovery data..."      r <- logException di1 (store_load sto di1 mId k)-     Di.debug di1 "Loaded."+     Di.debug_ di1 "Loaded."      -- Bonus track: Run GC to ensure we don't keep @x@ in memory.      System.Mem.performMajorGC      pure r   , store_delete = \di0 mId -> do      let di1 = Di.push "delete" di0-     Di.notice di1 "Deleting recovery data..."+     Di.notice_ di1 "Deleting recovery data..."      r <- logException di1 (store_delete sto di1 mId)-     Di.info di1 "Deleted."+     Di.info_ di1 "Deleted."      pure r   } @@ -528,10 +530,10 @@ -- | Add some extra logging to a 'Change'. pimpChange :: Change x -> Change x pimpChange (Change f) = Change $ \di0 d m x -> do-  let di1 = Di.attr "dir" (Df1.value d) (Di.push "alter" di0)-  Di.notice di1 "Running..."+  let di1 = Di.attr "dir" d $ Di.push "alter" di0+  Di.notice_ di1 "Running..."   logException di1 (f di1 d m x)-     <* Di.info di1 "Ran."+     <* Di.info_ di1 "Ran."  -------------------------------------------------------------------------------- @@ -756,6 +758,32 @@  -------------------------------------------------------------------------------- +-- | See 'unsafeCleanRegistry'.+data OnDirty+  = OnDirty_Abort+  | OnDirty_Commit+  deriving (Eq, Show)++-- | If the 'Registry' is currently 'Dirty', clean it up by __unsafely__+-- aborting or commiting the pending migration, as requested by 'OnDirty'.+unsafeCleanRegistry :: Di.Df1 -> Registry -> OnDirty -> IO ()+unsafeCleanRegistry di0 reg0 od = do+  let reg = mkRegistrish reg0+  fmap state_status (registrish_state reg di0) >>= \case+     Clean -> pure ()+     Dirty mId d -> do+        let di1 = Di.attr "dir" d+                $ Di.attr "mig" mId+                $ Di.push "unsafe-clean" di0+        Di.warning_ di1 "Migration registry is dirty."+        case od of+          OnDirty_Abort -> do+            Di.warning_ di1 "Unsafely aborting pending migration, as requested."+            registrish_abort reg di1 mId d+          OnDirty_Commit -> do+            Di.warning_ di1 "Unsafely commiting pending migration, as requested."+            registrish_commit reg di1 mId d+ -- | If the 'Registry' is currently 'Dirty', clean it up by running -- the dirty migration in the direction opposite than originally intended. cleanRegistry :: Di.Df1 -> Migs graph -> Registry -> IO ()@@ -764,16 +792,19 @@   fmap state_status (registrish_state reg di0) >>= \case      Clean -> pure ()      Dirty mId d1 -> do-        let di1 = Di.attr "mig" (Df1.value mId) (Di.push "clean" di0)-        Di.warning di1 "Migration registry is dirty. Cleaning it up by undoing."+        let di1 = Di.attr "dir" d1+                $ Di.attr "mig" mId+                $ Di.push "clean" di0+        Di.warning_ di1 "Migration registry is dirty."         case lookupMigs mId migs_ of            Nothing -> do-              Di.alert di1 "MigId in Registry but not in Plan."+              Di.alert_ di1 "MigId in Registry but not in Plan."               Ex.throwM (Err_CleanRegistry_NotFoundInMigs mId)            Just (_, UGone) -> do-              Di.alert di1 "Migration code is gone."+              Di.alert_ di1 "Migration code is gone."               Ex.throwM (Err_CleanRegistry_MigGone mId)            Just (_, UMig (st :: Store x) _ (Change ch)) -> do+              Di.notice_ di1 "Cleaning up by undoing..."               store_load st di1 mId $ \x -> do                  Ex.uninterruptibleMask $ \restore -> do                     restore (ch di1 (opposite d1) Recovery x)@@ -789,7 +820,7 @@      Clean -> do         let s1 :: Seq (MigId, UMig) = direction Seq.reverse id d0 s0         for_ s1 $ \(mId, UMig (st :: Store x) (Backup ba) (Change ch)) -> do-           let di1 = Di.attr "mig" (Df1.value mId) di0+           let di1 = Di.attr "mig" mId di0            when (d0 == Forwards) $ do               ba di1 (store_save st di1 mId)            -- If 'ioDelete' is 'True' when we finish processing our migration,@@ -928,19 +959,19 @@        { registrish_state = registry_state reg        , registrish_prepare = \di0 mId d -> do            let di1 = Di.push "registry" di0-           Di.debug di1 "Adding pending registry change..."+           Di.debug_ di1 "Adding pending registry change..."            logException di1 (f =<< registry_prepare reg di1 mId d)-           Di.debug di1 "Added pending registry change."+           Di.debug_ di1 "Added pending registry change."        , registrish_abort = \di0 mId d -> do            let di1 = Di.push "registry" di0-           Di.debug di1 "Aborting pending registry change..."+           Di.debug_ di1 "Aborting pending registry change..."            logException di1 (f =<< registry_abort reg di1 mId d)-           Di.debug di1 "Aborted pending registry change."+           Di.debug_ di1 "Aborted pending registry change."        , registrish_commit = \di0 mId d -> do            let di1 = Di.push "registry" di0-           Di.debug di1 "Commiting change to registry..."+           Di.debug_ di1 "Commiting change to registry..."            logException di1 (f =<< registry_commit reg di1 mId d)-           Di.debug di1 "Committed change to registry."+           Di.debug_ di1 "Committed change to registry."        }  --------------------------------------------------------------------------------@@ -1057,7 +1088,6 @@ -- given 'Df1'. logException :: (Ex.MonadMask m, MonadIO m) => Di.Df1 -> m a -> m a logException di0 m = do-  Ex.withException m $ \(se :: Ex.SomeException) -> do-     let di1 = Di.attr "exception" (fromString (show se)) di0-     Di.error di1 "Got exception!"+  Ex.withException m $ \se ->+     Di.error di0 (se :: Ex.SomeException)
lib/Moto/Internal/Cli.hs view
@@ -14,17 +14,15 @@  , run  ) where +import Control.Applicative ((<|>)) import qualified Control.Exception.Safe as Ex import qualified Data.ByteString.Builder as BB import Data.Foldable (for_, toList)-import qualified Data.Char as Char-import qualified Data.List as List import qualified Data.Map.Strict as Map import qualified Data.Set as Set import Data.String (fromString) import qualified Data.Text as T import qualified Data.Text.Encoding as T-import qualified Df1 import qualified Di.Df1 as Di import qualified Options.Applicative as OA import qualified System.Exit as IO@@ -44,10 +42,9 @@     -- refining it into some @r@ of our choosing acceptable as an input to     -- 'registryConf_with'.     ---    -- Ideally, this 'String' should be an URI-    -- (e.g., @file:\/\/\/var\/db\/migrations@,-    -- or @postgres:\/\/user:password\@host:port\/database@).-  , registryConf_with :: forall a. r -> (I.Registry -> IO a) -> IO a+    -- This could be something like @\/var\/db\/migrations@+    -- or @postgres:\/\/user:password\@host:port\/database@.+  , registryConf_with :: forall a. Di.Df1 -> r -> (I.Registry -> IO a) -> IO a     -- ^ Given the @r@ obtained from 'registryConf_parse', get a 'I.Registry'     -- that can be used within the given scope.   }@@ -68,8 +65,8 @@   -- command-line option.   --   -- Examples: @Moto.PostgreSQL.registryConf@ from-  -- the [moto-postgresql](https://hackage.haskell.org/package/moto-library),-  -- or @Moto.File.@'Moto.File.registryConf' from this library.+  -- the [moto-postgresql](https://hackage.haskell.org/package/moto-postgresql)+  -- library or @Moto.File.@'Moto.File.registryConf' from this library.   -> OA.Parser a   -- ^ This extra parser can be used to read some extra configuration   -- values from the command-line arguments, besides @moto@'s own.@@ -114,7 +111,7 @@  run_Run :: Di.Df1 -> I.Migs graph -> Opts_Run -> IO () run_Run di0 migs x = do-  runWithRegistry (opts_run_withRegistry x) $ \reg -> do+  runWithRegistry (opts_run_withRegistry x) di0 $ \reg -> do      I.getPlan di0 migs reg (opts_run_target x) >>= \case         Left e -> Ex.throwM e         Right p -> case opts_run_dryRun x of@@ -128,7 +125,7 @@  run_CheckMigrations :: Di.Df1 -> I.Migs graph -> Opts_CheckMigrations -> IO () run_CheckMigrations di0 migs x = do-  runWithRegistry (opts_checkMigrations_withRegistry x) $ \reg -> do+  runWithRegistry (opts_checkMigrations_withRegistry x) di0 $ \reg -> do     -- The 'I.Target' here is an unused dummy value.     I.getPlan di0 migs reg (I.Target I.Forwards Set.empty) >>= \case       Left _ -> IO.exitFailure@@ -136,31 +133,33 @@  run_ShowRegistry :: Di.Df1 -> Opts_ShowRegistry -> IO () run_ShowRegistry di0 x = do-  runWithRegistry (opts_showRegistry_withRegistry x) $ \reg -> do+  runWithRegistry (opts_showRegistry_withRegistry x) di0 $ \reg -> do     state <- I.registry_state reg di0     BB.hPutBuilder IO.stdout (renderState state)  run_CleanRegistry :: Di.Df1 -> I.Migs graph -> Opts_CleanRegistry -> IO () run_CleanRegistry di0 migs x = do-  runWithRegistry (opts_cleanRegistry_withRegistry x) $ \reg -> do+  runWithRegistry (opts_cleanRegistry_withRegistry x) di0 $ \reg -> do     case opts_cleanRegistry_dryRun x of-      False -> I.cleanRegistry di0 migs reg       True -> fmap I.state_status (I.registry_state reg di0) >>= \case         I.Dirty _ _ -> IO.exitFailure         I.Clean -> pure ()+      False -> case opts_cleanRegistry_unsafe x of+        Just od -> I.unsafeCleanRegistry di0 reg od+        Nothing -> I.cleanRegistry di0 migs reg  run_DeleteRecoveryData   :: Di.Df1 -> I.Migs graph -> Opts_DeleteRecoveryData -> IO () run_DeleteRecoveryData di0 migs x = do   for_ (Set.toList (opts_store_migIds x)) $ \mId -> do-    let di1 = Di.attr "mig" (Df1.value mId) di0+    let di1 = Di.attr "mig" mId di0     case I.lookupMigs mId migs of       Just (_, I.UMig store _ _) -> I.store_delete store di1 mId       Just (_, I.UGone) -> do-        Di.error di1 "Migration code is gone."+        Di.error_ di1 "Migration code is gone."         IO.exitFailure       Nothing -> do-        Di.error di1 "Migration not unknown."+        Di.error_ di1 "Migration not unknown."         IO.exitFailure  --------------------------------------------------------------------------------@@ -293,14 +292,28 @@                  OA.help "Don't clean registry, just show whether it is \                          \clean and exit immediately with status 0 if so, \                          \otherwise exit with status 1.")+  <*> (OA.flag' (Just I.OnDirty_Abort)+         (OA.long "unsafe-abort" <>+          OA.help "If the registry is dirty, unsafely abort the pending \+                  \migration without performing any actual clean-up.")+       <|>+       OA.flag' (Just I.OnDirty_Commit)+         (OA.long "unsafe-commit" <>+          OA.help "If the registry is dirty, unsafely commit the pending \+                  \migration without performing any actual clean-up.")+       <|>+       pure Nothing)  data Opts_CleanRegistry = Opts_CleanRegistry   { opts_cleanRegistry_withRegistry :: WithRegistry-  -- ^ Acquire a 'I.Registry' to use within a limited scope..+  -- ^ Acquire a 'I.Registry' to use within a limited scope.   , opts_cleanRegistry_dryRun :: Bool   -- ^ Whether to just show whether the registry is clean   -- and exit immediately with status 0 if the so,   -- otherwise exit with status 1.+  , opts_cleanRegistry_unsafe :: Maybe I.OnDirty+  -- ^ Whether to unsafely mark the registy as clean, without+  -- actualy performing any clean-up.   }  --------------------------------------------------------------------------------@@ -321,17 +334,17 @@ --------------------------------------------------------------------------------  data WithRegistry = WithRegistry-  { runWithRegistry :: forall a. (I.Registry -> IO a) -> IO a }+  (forall a. Di.Df1 -> (I.Registry -> IO a) -> IO a) +runWithRegistry :: WithRegistry -> Di.Df1 -> (I.Registry -> IO a) -> IO a+runWithRegistry (WithRegistry f) di0 k = f (Di.push "registry" di0) k+ oa_p_WithRegistry :: RegistryConf -> OA.Parser WithRegistry oa_p_WithRegistry (RegistryConf rh rp rw) = OA.option-  (OA.eitherReader $ \s -> do-     case List.dropWhileEnd Char.isSpace (List.dropWhile Char.isSpace s) of-       "" -> Left "Empty registry URI"-       s' -> case rp s' of-          Left e -> Left e-          Right r -> Right (WithRegistry (rw r)))-  (OA.long "registry" <> OA.metavar "URI" <> OA.help rh)+  (OA.eitherReader $ \s -> case rp s of+     Left e -> Left e+     Right r -> Right (WithRegistry (flip rw r)))+  (OA.long "registry" <> OA.metavar "SETTINGS" <> OA.help rh)  --------------------------------------------------------------------------------
lib/cli_help.docs view
@@ -28,12 +28,13 @@ Subcommand @run@:  @-Usage: moto-example run --registry URI [--backwards] [--mig ID] [--no-dry-run]+Usage: moto-example run --registry SETTINGS [--backwards] [--mig ID]+                        [--no-dry-run]   Run migrations.  Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/var\/db\/migrations+  --registry SETTINGS      File where registry file is stored. E.g.,+                           \/var\/db\/migrations   --mig ID                 If specified, only consider running the migration                            identified by this ID. Use multiple times for                            multiple migrations.@@ -59,13 +60,13 @@ Subcommand @check-migrations@:  @-Usage: moto-example check-migrations --registry URI+Usage: moto-example check-migrations --registry SETTINGS   Exit immediately with status 0 if the available migrations are compatible with   the registry. Otherwise, exit with status 1.  Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/var\/db\/migrations+  --registry SETTINGS      File where registry file is stored. E.g.,+                           \/var\/db\/migrations   -h,--help                Show this help text @ @@ -74,12 +75,12 @@ Subcommand @show-registry@:  @-Usage: moto-example show-registry --registry URI+Usage: moto-example show-registry --registry SETTINGS   Show migrations registry.  Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/var\/db\/migrations+  --registry SETTINGS      File where registry file is stored. E.g.,+                           \/var\/db\/migrations   -h,--help                Show this help text @ @@ -88,15 +89,20 @@ Subcommand @clean-registry@:  @-Usage: moto-example clean-registry --registry URI [--dry-run]+Usage: moto-example clean-registry --registry SETTINGS [--dry-run]+                                   ([--unsafe-abort] | [--unsafe-commit])   Clean a dirty migrations registry.  Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/var\/db\/migrations+  --registry SETTINGS      File where registry file is stored. E.g.,+                           \/var\/db\/migrations   --dry-run                Don't clean registry, just show whether it is clean                            and exit immediately with status 0 if so, otherwise                            exit with status 1.+  --unsafe-abort           If the registry is dirty, unsafely abort the pending+                           migration without performing any actual clean-up.+  --unsafe-commit          If the registry is dirty, unsafely commit the pending+                           migration without performing any actual clean-up.   -h,--help                Show this help text @
moto.cabal view
@@ -1,5 +1,5 @@ name: moto-version: 0.0.3+version: 0.0.4 synopsis: General purpose migrations library license: Apache-2.0 license-file: LICENSE.txt@@ -9,6 +9,8 @@ category: Database build-type: Simple cabal-version: >=2.0+homepage: https://gitlab.com/k0001/moto+bug-reports: https://gitlab.com/k0001/moto/issues  library   hs-source-dirs: lib@@ -36,6 +38,7 @@       mtl,       optparse-applicative,       pipes,+      pipes-aeson,       pipes-attoparsec,       pipes-bytestring,       safe-exceptions,
test/Main.hs view
@@ -38,6 +38,7 @@ import Test.Tasty.QuickCheck ((===)) import qualified Test.Tasty.Runners as Tasty +import qualified Moto import qualified Moto.Internal as U import qualified Moto.File @@ -52,7 +53,7 @@ --------------------------------------------------------------------------------  backup_noop :: x -> U.Backup x-backup_noop x = U.Backup (\_ k -> k x)+backup_noop x = fmap (\() -> x) Moto.dummyBackup  backup_fail_sync :: String -> U.Backup x backup_fail_sync s = U.Backup (\_ _ -> fail_sync s)@@ -60,8 +61,7 @@ --------------------------------------------------------------------------------  store_noop :: x -> U.Store x-store_noop x =-  U.Store (\_ _ _ -> pure ()) (\_ _ k -> k x) (\_ _ -> pure ())+store_noop x = U.mapStore (const ()) (const x) Moto.dummyStore  store_fail_sync_save :: x -> String -> U.Store x store_fail_sync_save x s =@@ -607,7 +607,7 @@   :: forall a. Di.Df1 -> U.Status -> [U.MigId] -> (U.Registry -> IO a) -> IO a withExpectedTestRegistry di sex idsex k = do   dir <- getTempDir-  Moto.File.withRegistry (dir ++ "/reg") $ \reg -> do+  Moto.File.withRegistry di (dir ++ "/reg") $ \reg -> do     Ex.finally (k reg) $ do       s <- Ex.evaluate =<< U.registry_state reg di       (sex, idsex) @=? (U.state_status s, map fst (U.state_committed s))