moto 0.0.2 → 0.0.3

raw patch · 14 files changed

+2212/−2223 lines, 14 files

Files

• CHANGELOG.md +6/−0
• lib/Moto.hs +276/−0
• lib/Moto/File.hs +220/−0
• lib/Moto/Internal.hs +1063/−0
• lib/Moto/Internal/Cli.hs +412/−0
• lib/Moto/Registry.hs +115/−0
• lib/cli_help.docs +114/−0
• lib/moto-internal/Moto/Internal.hs +0/−1062
• lib/moto-internal/Moto/Internal/Cli.hs +0/−411
• lib/moto/Moto.hs +0/−276
• lib/moto/Moto/File.hs +0/−220
• lib/moto/Moto/Registry.hs +0/−115
• lib/moto/cli_help.docs +0/−114
• moto.cabal +6/−25

@@ -1,3 +1,9 @@+# Version 0.0.3++* Haddocks and Hackage choke on internal Cabal libraries, so we remove the+  internal `moto-internal` library.++ # Version 0.0.2  * Added file missing from distribution.

@@ -0,0 +1,276 @@+{-# LANGUAGE CPP #-}++{- |++@moto@ is a library for describing and running /migrations/.++A /migration/ is any code that changes the environment somehow. The+stereotypical example of a migration is code that modifies the schema of a+database, but really anything that changes the environment somehow can be seen+as a migration. For example, moving a file to a different directory or host,+installing a package, deploying infrastructure, etc.++Essentially, a migration is a glorified bash script to which we hold dear because+of how devastating it can be for our project if we get it wrong. @moto@+understands this, so it is very careful about how, when, where and why it runs+these migrations, paying special attention to what happens when something goes+wrong. Of course, this being Haskell, we are encouraged to use domain specific+tools that can prevent us from accidentally writing the wrong migration code+(e.g., deleting a database rather than modifying it).++In @moto@ we can specify migrations in such a way that any data that is going+modified or deleted by a migration can be backed up for us in one or more+storages of our choice. If anything goes wrong, or if we latter decide to undo+these changes, then this backup will be automatically made available to us.++@moto@ is excellent for teams, where multiple collaborators can add new+migrations to the project at the same time, establishing dependencies between+them by saying “this migration needs to run before that other one” as a graph.+At compile time, @moto@ will ensure whether there is at least one way to execute+these migrations graph sequentially, or fail to compile otherwise. And at+runtime, it will execute this graph in any way that's compatible with the+environment where the migrations are being run. We don't need to worry about+serializing the release and deployment of migrations anymore, nor about making+sure that everybody runs migrations in the same order. We can delegate that+responsibility to @moto@.++Also, @moto@ is an excellent interface to interacting with our migrations and+environment. The final product we obtain as a user of @moto@ is a ready-made+/command line interface/ program that we can deploy and use to run all or some+migrations, undo them, render the dependency graph, compare it with the current+registry of migrations that have been run so far, obtain an execution plan as+well as very detailed logs in human and computer readable formats, etc.++@moto@ relies on a /registry/ of migrations to understand what has been run so+far and what hasn't. We can decide whether to keep this state locally or in+a remote database.++Last, but not least, @moto@ encourages us to remove old migrations after some+time, once these migrations are so old that maintaining them in the project is+an unnecessary burden to us. To this end, @moto@ offers us enough vocabulary to+mark said migrations as /gone/.++This module is inteded to be imported qualified:++@+import qualified "Moto"+@++-}+module Moto+ (+ -- * Example+ --+ -- $example++ -- * Frequently Asked Questions+ --+ -- $faq++ -- * Running+   IC.run+ , IC.Opts+ , IC.getOpts++ -- * Describing individual migrations+ , I.Mig(..)+ , I.Store(..)+ , I.mapStore+ , I.Backup(..)+ , I.Change(..)+ , I.Direction(..)+ , I.direction+ , I.Mode(..)+ , I.MigId(..)++ -- * Describing migrations graph+ , I.Migs+ , I.migs+ , (I.*)+ , I.DAG++ -- * Command line help+ --+ -- $cli_help+ ) where++import qualified Moto.Internal as I+import qualified Moto.Internal.Cli as IC++{- $example++The main interface to running migrations is the command line. As a user of+@moto@, we are expected to create an executable that calls 'I.cli'. This+executable can then be deployed and used to run migrations.++Usually, the code in this executable will look like this:++@+\{\-\# LANGUAGE DataKinds \#\-\}+\{\-\# LANGUAGE PartialTypeSignatures \#\-\}+++-- Our project will be an executable, so we name our module Main as it is+-- customary.+module Main (main) where+++-- "Moto" is designed to be imported qualified, as well as "Di", a module that+-- provides the logging support required by "Moto".+import qualified "Di"+import qualified "Moto"++-- Moreover, in this example we will use a migrations registry from the+-- "Moto.File" module as an example.+import qualified "Moto.File"+++-- Here are some migrations, each of them with a identifier and a set of+-- identifiers for other migrations expected to be executed before them when+-- going 'Moto.Forwards'.+--+-- Optional: It is actually recommended to put each migration in its own module.+-- It is not necessary, but GHC takes a longer time and more resources to+-- compile big modules. And considering the list of migrations in our project+-- will always be growing, it's better to organize things that way from the+-- start, as this can quickly become a source of slow compilation times.  For+-- example, instead of Main.mig_black and Main.mig_blue, we can have+-- MyProject.Migs.Black.mig and MyProject.Migs.Blue.mig that we import as+-- necessary.+mig_red :: Moto.Mig "red" '["blue"]+mig_red = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.++mig_yellow :: Moto.Mig "yellow" '["black","red"]+mig_yellow = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.++mig_green :: Moto.Mig "green" '["red"]+mig_green = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.++mig_black :: Moto.Mig "black" '["blue"]+mig_black = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.++mig_blue :: Moto.Mig "blue" '[]+mig_blue = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.+++-- All of the 'Mig's that we might want to run need to be put in directed+-- acyclic graph where each migration is a node and each edge is a dependency+-- between migrations. In "Moto", we use 'Moto.migs' and the infix 'Moto.*'+-- function to safely construct the graph of migrations.  The way we define our+-- 'Moto.Migs' is a bit strange. Let's understand why.+--+-- The Moto.* infix function says that the migrations that appear syntactically+-- to its right can only mention as their dependencies migrations that appear+-- to its syntactic left. This prevents us from mentioning our migrations in+-- any order, but on the other hand it ensures at construction that there are no+-- cycles nor dangling references in our dependency graph. If we get the order+-- wrong, we will get a type-checker error. Moreover, migration identifiers are+-- forced to be unique within this graph. The Moto.migs value itself is a dummy+-- starting point we use as the leftmost argument to our chain of Moto.* calls.+--+-- Observation: Note we avoid giving an explicit type to myMigs. Instead, we+-- used the PartialTypeSignatures GHC extension to put an underscore there and+-- allow GHC to use the inferred type. This is a desirable thing to do so as to+-- prevent type-inference from accidentally inferring an undesired identifier+-- for our migrations. This approach forces all of our Moto.Mig values to have+-- their identifiers and dependencies fully specified at their definition site.+-- We could have accomplished the same by not giving an type signature to our+-- top level myMigs, or by simply inlining our definition of myMigs at its use+-- site later on.+myMigs :: Moto.Migs _+myMigs = Moto.migs+  Moto.* mig_blue+  Moto.* mig_red+  Moto.* mig_black+  Moto.* mig_green+  Moto.* mig_yellow+++-- Finally, we have our main entry point. This program can be run from the+-- command line and allows us to run and inspect migrations.+main :: IO ()+main = do++   -- Using 'Moto.getOpts' we parse the command-line arguments and obtain the+   -- instructions necessary to call 'Moto.run' afterwards.  We specify as+   -- arguments a 'Moto.Cli.RegistryConf' that describes the migrations+   -- registry where we keep track of the migrations that have run so far, as+   -- well as any extra command-line parsing needs we may have. In our case, we+   -- use a file in the filesystem as our registry, and we don't do any extra+   -- command-line argument parsing. Please see the documentation of+   -- 'Moto.getOpts' for more details.+   (myOpts, ()) <- Moto.getOpts Moto.File.registryConf (pure ())++   -- @moto@ uses "Di" for its own logging, so we first+   -- need to obtain a @'Di.Di' 'Df1.Level' 'Df1.Path' 'Df1.Message'@ value (also+   -- known by its 'Di.Df1' synonym). We can do this using 'Di.new'.+   Di.new $ \\di -> do++      -- Finally, we 'Moto.run' @moto@ as instructed by @myOpts@, passing in the+      -- 'Di.Df1' we just obtained, as well as the migrations graph+      Moto.run di myMigs myOpts+@+-}++{- $faq++Here are some answers to questions you'll frequently ask yourselves when using+@moto@.++[Where should we maintain the migrations code for our project?]+Ideally, if you keep your whole project in a single code repository, you should+keep the migrations in that same repository, so that they are always in sync+with the code they cater for. You should create a standalone executable program+for running your migrations.++[Should my migrations program depend on the code I am migrating?]+Definitely not. That code will change or disappear over time, and it will affect+your migrations code whenever it changes. Your migrations code should stand+alone and have a holistic view of the history of the many environments where+your project runs, without depending on it.++[Can I use @moto@ to migrate projects not written in Haskell?]+Yes, @moto@ doesn't care about the language your project is written in. However,+the migrations code itself will have to be written Haskell.++[How do I deploy this?]+The same way you deploy other executables. We recommend packaging the program as+a Nix derivation containing a statically linked executable. Moreover, you can+package the migrations execution as a NixOS module that runs automatically+whenever a new version is deployed. Future versions of @moto@ will provide a web+interface for making migration execution a bit more interactive.++[How do I make sure my migrations work before deploying them?]+Generally speaking, as much as possible, you should use domain-specific+type-safe DSLs to describe your changes. But still, eventually, try the real+thing locally. Don't try to “mock” scenarios, that doesn't help. @moto@ makes+it quite easy to run migrations backwards afterwards. Moreover, in order to try+recovery scenarios, you try and throw exceptions from the different parts of+your migrations and see what happens.++[I don't see anything about SQL nor versioned data-types here]+Whether you are modifying an SQL database or moving any other kind of+bits around, @moto@ doesn't care about those details. You can write all the SQL+you want inside your migration, using the SQL-supporting library of your choice,+or version your datatypes as well.++[Is this ready for production?]+Migrations are a tricky business, and this is a very early release of @moto@, so+use at your own risk.++[Is the API stable?]+No, and it will never be. We will always break the API as necessary if it allows+us offer better safety and experience. However, we understand the subtle nature+of the projects relying on @moto@ an we will take the necessary steps to ensure+a positive and maintainable experience over time. Please see+the [changelog](https://hackage.haskell.org/package/moto/changelog) to+understand differences between versions and learn about any necessary changes+you'll need to make. In a @moto@ version @x.y.z@, we will always increase one of+@x@ or @y@ whenever a new version introduces backwards incompatible changes.++[I have more questions!]+We have more answers. Just [ask](https://gitlab.com/k0001/moto/issues).++-}+#include "cli_help.docs"+

@@ -0,0 +1,220 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module exports a 'I.Store' that stores 'I.Backup' data as files in the+-- filesystem, as well as a 'I.Registry' backed by a file in the filesystem and+-- related tools.+--+-- Please import as:+--+-- @+-- import qualified "Moto.File"+-- @+module Moto.File+ ( -- * Registry+   registryConf+ , withRegistry++ , -- * Store+   store+ ) where++import Control.Applicative (empty)+import qualified Control.Exception.Safe as Ex+import qualified Control.Monad.Trans.State.Strict as S+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans (lift)+import qualified Data.Aeson as Ae+import qualified Data.Attoparsec.ByteString.Char8 as A8+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.Char as Char+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import GHC.IO.Handle as IO (LockMode(ExclusiveLock), hLock)+import qualified Pipes as P+import qualified Pipes.Attoparsec as Pa+import qualified Pipes.ByteString as Pb+import qualified System.Directory as Dir+import System.FilePath ((</>))+import qualified System.IO as IO+import qualified System.IO.Error as IO++import qualified Moto.Internal as I+import qualified Moto.Internal.Cli as IC+import qualified Moto.Registry as R++--------------------------------------------------------------------------------++-- | Command-line configuration for a 'I.Registry' stored as a file in the+-- 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_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+  }++-- | 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+  -- ^ File where to store the registry logs.+  --+  -- An exclusive lock will be set on the this file (see 'IO.hLock'), which will+  -- stay open until this function returns. This is to prevent other programs to+  -- interact with this file while this program is running.+  -> (I.Registry -> m a)+  -> m a+withRegistry fp =+  withRegistryCustom renderLogLine parseLogLine fp++-- | Obtain a 'I.Registry' backed by an append-only file storage as described by+-- 'R.newAppendOnlyRegistry'.+withRegistryCustom+  :: (MonadIO m, Ex.MonadMask m)+  => (I.Log -> BB.Builder)+  -- ^ Render a single 'I.Log'. Be sure to add a trailing newline or similar if+  -- necessary, in order to separate one 'I.Log' entry from the next.+  -> 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.+  -> IO.FilePath+  -- ^ File where to store the registry logs.+  --+  -- An exclusive lock will be set on the this file (see 'IO.hLock'), which will+  -- stay open until this function returns. This is to prevent other programs to+  -- interact with this file while this program is running.+  -> (I.Registry -> m a)+  -> m a+withRegistryCustom render parser fp k = do+  Ex.bracket+    (liftIO $ do+       h <- IO.openBinaryFile fp IO.ReadWriteMode+       IO.hLock h IO.ExclusiveLock+       pure h)+    (liftIO . IO.hClose)+    (\h -> k =<< liftIO (do+       state0 <- do+          ea <- flip S.runStateT I.emptyState $ P.runEffect $ do+             P.for (Pa.parsed parser (Pb.fromHandle h)) $ \l -> do+                s0 <- lift S.get+                lift (either Ex.throwM S.put (I.updateState s0 l))+          case ea of+             (Left (e,_), _) -> Ex.throwM (I.Err_MalformedLog (show e))+             (Right _, x) -> pure x+       R.newAppendOnlyRegistry state0 $ \log' -> do+          BB.hPutBuilder h (render log')+          IO.hFlush h))++--------------------------------------------------------------------------------++-- Renders a 'I.Log' as a line of text with a trailing new line.+--+-- Use 'parseLogLine' to undo this rendering.+renderLogLine :: I.Log -> BB.Builder+renderLogLine l = Ae.fromEncoding (Ae.toEncoding (LogV1 l)) <> "\n"++-- Parses a 'I.Log' from a line of text rendered by 'renderLogLine'.+--+-- Any leading or trailing newlines are consumed and skipped.+parseLogLine :: A8.Parser I.Log+parseLogLine = do+  _ <- A8.skipWhile (== '\n')+  s <- A8.takeWhile (/= '\n')+  _ <- A8.skipWhile (== '\n')+  case Ae.decodeStrict s of+     Just (LogV1 l) -> pure l+     Nothing -> fail "Malformed Log"++-- | Wrapper around 'I.Log' used for serialization purposes, so that we don't+-- expose a 'Ae.ToJSON' instance for 'I.Log'.+newtype LogV1 = LogV1 I.Log++instance Ae.ToJSON LogV1 where+  toJSON (LogV1 l) = case l of+    I.Log_Commit t -> Ae.toJSON $ Ae.object+      [ "action" Ae..= ("commit" :: T.Text)+      , "timestamp" Ae..= t ]+    I.Log_Abort t -> Ae.toJSON $ Ae.object+      [ "action" Ae..= ("abort" :: T.Text)+      , "timestamp" Ae..= t ]+    I.Log_Prepare t (I.MigId m) d -> Ae.toJSON $ Ae.object+      [ "action" Ae..= ("prepare" :: T.Text)+      , "timestamp" Ae..= t+      , "migration" Ae..= m+      , "direction" Ae..= (I.direction "backwards" "forwards" d :: T.Text) ]++instance Ae.FromJSON LogV1 where+  parseJSON = Ae.withObject "Log" $ \o -> do+    a :: T.Text <- o Ae..: "action"+    fmap LogV1 $ case a of+       "commit" -> I.Log_Commit+          <$> (o Ae..: "timestamp")+       "abort" -> I.Log_Abort+          <$> (o Ae..: "timestamp")+       "prepare" -> I.Log_Prepare+          <$> (o Ae..: "timestamp")+          <*> fmap I.MigId (o Ae..: "migration")+          <*> (o Ae..: "direction" >>= \case+                  "backwards" -> pure I.Backwards+                  "forwards" -> pure I.Forwards+                  (_ :: T.Text) -> empty)+       _ -> empty++--------------------------------------------------------------------------------++-- | A 'Store' that keeps data stored as files (one per 'MigId') in a filesystem+-- directory.+--+-- For maximum memory consumption efficiency, the data is written and read in a+-- streaming fasion using a 'P.Producer'.+store+  :: FilePath -- ^ Path to a directory where the files are or will be stored.+  -> I.Store (P.Producer B.ByteString IO ())+store fp_dir = I.Store+    { I.store_save = \_ mId x -> do+        Dir.createDirectoryIfMissing True fp_dir+        Ex.bracket+          (IO.openBinaryFile (fp mId) IO.WriteMode)+          IO.hClose+          (\h -> do+             IO.hSetFileSize h 0+             IO.hSetBuffering h (IO.BlockBuffering Nothing)+             P.runEffect (x P.>-> Pb.toHandle h))+    , I.store_load = \_ mId k -> Ex.bracket+        (IO.openBinaryFile (fp mId) IO.ReadMode)+        IO.hClose+        (k . Pb.fromHandle)+    , I.store_delete = \_ mId -> Ex.catch+        (Dir.removeFile (fp mId))+        (\case e | IO.isDoesNotExistError e -> pure ()+                 | otherwise -> Ex.throwM e)+    }+  where+    fp :: I.MigId -> FilePath+    fp = \mId -> fp_dir </> TL.unpack (TL.decodeUtf8 (I.migId_sha1Hex mId)) <>+                            "_" <> escapeFileName (T.unpack (I.unMigId mId))+    escapeFileName :: String -> FilePath+    escapeFileName = map (\case c | Char.isAscii c && Char.isAlphaNum c -> c+                                  | otherwise -> '_')++{- TODO save this to a README file+    readme :: BB.Builder+    readme = "This directory contains backups made by Moto.File.store.\n\+             \\n\+             \  https://hackage.haskell.org/package/moto/docs/Moto-File.html#v:store\n\n\+             \\n\+             \To backup these backups, it is sufficient to copy the contents\n\+             \of this directory, preserving the file names."+-}

@@ -0,0 +1,1063 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UndecidableSuperClasses #-}+{-# OPTIONS_HADDOCK hide #-}++module Moto.Internal+ ( run++ -- * Describing migrations+ , Mig(Mig, Gone)+ , UMig(UMig, UGone)+ -- ** Backup+ , Backup(Backup)+ -- ** Change+ , Change(Change)+ -- ** Store+ , Store(Store, store_save, store_load, store_delete)+ , mapStore++  -- *** Direction+ , Direction(Backwards, Forwards)+ , direction+ , opposite++ -- *** Mode+ , Mode(Normal, Recovery)++ -- * Execution plan+ , Migs(Migs)+ , migs+ , (Moto.Internal.*)+ , DAG+ , lookupMigs++ , Target(..)++ , Plan(Plan)+ , mkPlan+ , getPlan++ , MigId(MigId, unMigId)+ , migId+ , migId_sha1Hex++ -- * Registry+ , Registry(..)+ , cleanRegistry++ -- * State+ , State+ , state_status+ , state_committed+ , emptyState+ , updateState+ , Status(..)+ , Log(..)++ -- * Errors+ , Err_Run(..)+ , Err_Plan(..)+ , Err_Prepare(..)+ , Err_Abort(..)+ , Err_Commit(..)+ , Err_UpdateState(..)+ , Err_MalformedLog(..)+ ) where++import Control.Arrow ((&&&))+import Control.Monad (when)+import qualified Control.Exception.Safe as Ex+import Control.Monad.IO.Class (MonadIO)+import qualified Crypto.Hash.SHA1 as SHA1+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Builder.Prim as BBP+import qualified Data.ByteString.Lazy as BL+import Data.Foldable (for_)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import qualified Data.List as List+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import Data.Proxy (Proxy(..))+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Set (Set)+import qualified Data.Set as Set+import Data.String (IsString, fromString)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Time as Time+import qualified Df1+import qualified Di.Df1 as Di+import GHC.Exts (Constraint)+import GHC.TypeLits (KnownSymbol, symbolVal, Symbol)+import qualified GHC.TypeLits as GHC+import qualified System.Mem++--------------------------------------------------------------------------------++-- | The directed acyclic graph of migrations available for execution.+--+-- Construct using 'Moto.migs' and 'Moto.*'. For example:+--+-- @+-- 'Moto.migs' 'Moto.*' someMig 'Moto.*' anotherMig 'Moto.*' ...+-- @+newtype Migs (graph :: [(Symbol, [Symbol])])+  = Migs (Map MigId (Set MigId, UMig))+  -- ^ Unsafe constructor. A map from 'MigId's, to the 'UMig' identfified by it,+  -- as well as a set of all of the 'MigId's that must be executed before it.++-- | An empty, yet valid, graph of migrations.+--+-- You can use 'Moto.migs' as a starting point for constructing bigger+-- migrations graphs. For example:+--+-- @+-- 'Moto.migs' 'Moto.*' someMig 'Moto.*' anotherMig 'Moto.*' ...+-- @+migs :: Migs '[]+migs = Migs Map.empty++-- | Add a new migration with an unique identifier @id@ depending on each of+-- @deps@ to a graph of migrations @graph@.+--+-- The 'DAG' constraint guarantees that the result is a directed acyclic graph.+--+-- To create a 'Migs' from scratch, use 'Moto.*' in combination with+-- 'Moto.migs'. For example:+--+-- @+-- 'Moto.migs' 'Moto.*' someMig 'Moto.*' anotherMig 'Moto.*' ...+-- @+infixl 7 *+(*) :: DAG id deps graph+    => Migs graph+    -> Mig id deps+    -- ^ @id@ must not be present in @graph@.+    --+    -- All of @deps@ must be present in @graph@.+    -> Migs ('(id, deps) ': graph)+(*) (Migs m) (mig :: Mig id deps) =+  let umig = case mig of+        Mig s b c -> UMig (pimpStore s) (pimpBackup b) (pimpChange c)+        Gone -> UGone+  in Migs (Map.insert (migId (Proxy :: Proxy id))+                      (Set.fromList (migIds (Proxy :: Proxy deps)), umig)+                      m)++-- | This 'Constraint' is automatically satisfied by an @id@ that is absent from+-- @graph@, and @deps@ listing identifiers present in the given @graph@.+--+-- In other words, 'DAG' effectively forces 'Moto.*' to always build Directed+-- Acyclic Graphs (hence the name).+--+-- @+-- 'DAG' id deps graph :: 'Constraint'+-- @+type DAG id deps graph = DAG_ id deps graph++-- | We don't export this to keep the haddocks clean.+type DAG_ (id :: Symbol) (deps :: [Symbol]) (graph :: [(Symbol, [Symbol])])+  = ( NotMember id deps+    , NotMember id (Ids graph)+    , Subset deps (Ids graph)+    -- The following two constraints have nothing to do with DAGs, but by+    -- putting them here we can keep the type of 'Moto.*' less noisy.+    , KnownSymbol id+    , KnownSymbols deps+    )++-- | Obtain a term-level representation of a migration identifier from its+-- type-level representation as a 'Symbol' (as it appears in the @id@ type+-- parameter to 'Mig').+migId :: KnownSymbol id => Proxy id -> MigId+migId = MigId . fromString . symbolVal++-- | Obtain a term-level representation of some migration identifiers from their+-- type-level representation as @['Symbol']@ (as they appear in the @id@ type+-- parameter to 'Mig').+migIds :: KnownSymbols ids => Proxy ids -> [MigId]+migIds = map (MigId . fromString) . symbolVals++lookupMigs :: MigId -> Migs graph -> Maybe (Set MigId, UMig)+lookupMigs mId (Migs m) = Map.lookup mId m++class All KnownSymbol ids => KnownSymbols (ids :: [Symbol]) where+  symbolVals :: Proxy ids -> [String]+instance KnownSymbols '[] where+  symbolVals _ = []+instance (KnownSymbol id, KnownSymbols ids) => KnownSymbols (id ': ids) where+  symbolVals (_ :: Proxy (id ': ids))+    = symbolVal (Proxy :: Proxy id)+    : symbolVals (Proxy :: Proxy ids)++type family All (f :: k -> Constraint) (as :: [k]) :: Constraint where+  All _ '[] = ()+  All f (a ': as) = (f a, All f as)++type family Subset (small :: [k]) (big :: [k]) :: Constraint where+  Subset '[] _ = ()+  Subset (a ': as) bs = (Member a bs, Subset as bs)++type family Ids (abs :: [(ka,kb)]) :: [ka] where+  Ids '[] = '[]+  Ids ( '(a,_) ': abs ) = (a ': Ids abs)++type Member (a :: k) (as :: [k]) = Member_ a as (IsMember a as)+type family Member_ (a :: k) (as :: [k]) (found :: Bool) :: Constraint where+  Member_ _ _ 'True = ()+  Member_ a as 'False = GHC.TypeError+    ('GHC.ShowType a 'GHC.:<>:+     'GHC.Text " is not a member of " 'GHC.:<>:+     'GHC.ShowType as)++type NotMember (a :: k) (as :: [k]) = NotMember_ a as (IsMember a as)+type family NotMember_ (a :: k) (as :: [k]) (found :: Bool) :: Constraint where+  NotMember_ _ _ 'False = ()+  NotMember_ a as 'True = GHC.TypeError+    ('GHC.ShowType a 'GHC.:<>:+     'GHC.Text " is a member of " 'GHC.:<>:+     'GHC.ShowType as)++type family IsMember (a :: k) (as :: [k]) :: Bool where+  IsMember _ '[] = 'False+  IsMember a (a ': _) = 'True+  IsMember a (b ': as) = IsMember a as++--------------------------------------------------------------------------------++-- | Direction in which a migration runs.+--+-- Running it 'Forwards' conveys the idea of “advancing” or “improving” your+-- state over time somehow, while running it 'Backwards' conveys the idea of+-- undoing all the changes that the migration does when going 'Forwards'.+data Direction = Backwards | Forwards+  deriving stock (Eq, Ord, Show, Read)++-- | Case analysis for 'Direction'. Evaluate to the first @a@ in case it is+-- 'Backwards', otherwise to the second @a@.+direction :: a -> a -> Direction -> a+direction bw fw = \case { Backwards -> bw; Forwards -> fw }++-- | The opposite of the given direction.+opposite :: Direction -> Direction+opposite = direction Forwards Backwards++instance Df1.ToValue Direction where+  value = direction "backwards" "forwards"++--------------------------------------------------------------------------------++-- | A single side-effecting migration uniquely identfied by @id@ and depending+-- on all of the migrations listed in @deps@.+--+-- These migration identifiers that appear as type-level 'Symbol' here, will be+-- of type 'MigId' when represented at the type level.+data Mig (id :: Symbol) (deps :: [Symbol]) where+  -- | Description of the different phashes that make up this migration+  -- identified by @id@, depending on others identified by @deps@.+  Mig :: Store x+      -- ^ How to save and load data obtained during the 'Backup' phase when+      -- necessary.+      --+      -- Please note that you can reuse this same 'Store' across different+      -- migrations.+      --+      -- Any stored data will remain in the 'Store' until it is not necessary+      -- anymore (but it can be manually deleted if desired, at your own risk).+      --+      -- Please refer to 'Store' for further documentation.+      -> Backup x+      -- ^ Backup phase of this migration+      --+      -- This phase is executed only once when trying to run the migration+      -- 'Forwards' for the first time.+      --+      -- Please refer to 'Backup' for further documentation.+      -> Change x+      -- ^ Change phase of this migration.+      --+      -- This phase is executed both when going 'Forwards' and 'Backwards'. Here+      -- we alter the environment somehow while having access to the @x@ data+      -- obtained in the 'Backup' phase.+      --+      -- Please refer to 'Change' for further documentation.+      -> Mig id deps++  -- | This constructor conveys the idea that code for a particular migration is+  -- gone, while still communicating the dependencies that this migration used+  -- to have so that we don't change the past dependency graph over time, which+  -- would make it impossible for @moto@ to operate reliably.+  Gone :: Mig id deps++-- | Internal. Like 'Mig', but without the type level data.+data UMig where+  UGone :: UMig+  UMig :: Store x -> Backup x -> Change x -> UMig++--------------------------------------------------------------------------------++-- | The backup phase of a migration, collecting some data @x@ for backup in a+-- 'Store'.+--+-- Here we interact with the environment in a /read-only/ manner, collecting all+-- data that may be destroyed by a subsequent 'Change' phase for backup in some+-- 'Store'.+--+-- This data will be crucial for automatic recovery in case the 'Change' phase+-- of the 'Mig' that uses this 'Backup' fails, or in case we manually decide to+-- undo said 'Mig' at a later time. Thus, when deciding what data to return as+-- @x@, please consider those scenarios.+--+-- The actual storing of the backup data is performed by the 'Store' that is+-- used as part of the same 'Mig'. That is, we don't physically store+-- the data within this 'Backup', all we do is return it as @x@.+--+-- Please keep in mind that depending on your environment, @x@ could be really+-- large, so in those situations it best for @x@ to be some kind of /stream/+-- (e.g., a 'Pipes.Producer').+--+-- Notice that @x@ is returned in a continuation-passing style so that we can+-- do proper resource deallocation after @x@ has been consumed. Using @x@+-- outside of this intended scope is undefined.+data Backup (x :: *) = Backup (forall r. Di.Df1 -> (x -> IO r) -> IO r)++-- | 'Backup' is covariant with @x@.+instance Functor Backup where+  fmap f (Backup g) = Backup (\di k -> g di (k . f))++-- | Add some extra logging to a 'Backup'.+pimpBackup :: Backup x -> Backup x+pimpBackup (Backup f) = Backup $ \di0 k -> do+  let di1 = Di.push "backup" di0+  Di.debug di1 "Running..."+  r <- logException di1 (f di1 k)+  Di.debug di1 "Ran."+  -- Bonus track: Run GC to ensure we don't keep @x@ in memory.+  System.Mem.performMajorGC+  pure r++--------------------------------------------------------------------------------++-- | A 'Store' describes how to save, load and delete the @x@ data obtained by+-- a 'Backup'.+--+-- This @x@ data is used later by the 'Change' phase.+--+-- A single 'Store' might be used by different 'Mig's.+--+-- Hint: 'Moto.File.store' from the "Moto.File" module is a 'Store' you can use+-- that's distributed with the main @moto@ library.+data Store (x :: *) = Store+  { store_save :: Di.Df1 -> MigId -> x -> IO ()+    -- ^ Saves the @x@ data originating from a 'Backup' step for a migration+    -- identified by 'MigId', __overwriting__ previous data if any.+    --+    -- If it's not possible to save the @x@ data, then this function must+    -- fail with some exception.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but please don't log exceptions nor messages telling whether+    -- this function succeeds or fails, since this library already does that for+    -- you.+  , store_load :: forall r. Di.Df1 -> MigId -> (x -> IO r) -> IO r+    -- ^ Load the data previously saved by 'store_save', for a migration+    -- identified by the given 'MigId'.+    --+    -- Notice that @x@ is returned in a continuation-passing style so that we+    -- can do proper resource deallocation after @x@ has been consumed. Using+    -- @x@ outside of this intended scope is undefined.+    --+    -- If it's was not possible to load the @x@ data, then this function must+    -- fail with some exception.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but please don't log exceptions nor messages telling whether+    -- this function succeeds or fails, since this library already does that for+    -- you.+  , store_delete :: Di.Df1 -> MigId -> IO ()+    -- ^ Delete the data previously saved by 'store_save', if any. for a+    -- migration identified by the given 'MigId'.+    --+    -- If it's there was no data to delete, then this function should return+    -- @()@. On the other hand, if its acceptable to throw exceptions when+    -- it's not possible to access the underlying storage.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but please don't log exceptions nor messages telling whether+    -- this function succeeds or fails, since this library already does that for+    -- you.+  }++-- | Given isomorpisms between @a@ and @b@, obtain an function from+-- @'Store' a@ and @'Store' b@.+--+-- A @'Store' x@ is both covariant and contravariant with @x@.+--+-- This function respects the functor laws.+mapStore+  :: (b -> a) -- ^ Isomorphism from @b@ to @a@.+  -> (a -> b) -- ^ Isomorphism from @a@ to @b@.+  -> Store a+  -> Store b+mapStore ba ab = \(Store s l d) ->+  Store (\di mId b -> s di mId (ba b))+        (\di mId kb -> l di mId (kb . ab))+        d++-- | Add some extra logging to a 'Store'.+pimpStore :: Store a -> Store a+pimpStore sto = sto+  { store_save = \di0 mId x -> do+     let di1 = Di.push "save" di0+     Di.debug di1 "Saving recovery data..."+     logException di1 (store_save sto di1 mId x)+     Di.debug di1 "Saved."+  , store_load = \di0 mId k -> do+     let di1 = Di.push "load" di0+     Di.debug di1 "Loading recovery data..."+     r <- logException di1 (store_load sto di1 mId k)+     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..."+     r <- logException di1 (store_delete sto di1 mId)+     Di.info di1 "Deleted."+     pure r+  }++--------------------------------------------------------------------------------++-- | Execution mode of a migration, describing why and how a 'Change' migration+-- is being run.+data Mode+  = Normal+  -- ^ The migration is being run as requested by the user, in the requested+  -- 'Direction'. Every previous step until now has run successfully. You can+  -- assume a clean starting point.+  --+  -- If running the migration in 'Normal' mode fails, the same migration will be+  -- run again in 'Recovery' mode /in the opposite 'Direction'/ as a way to+  -- undo any partial changes and go back to having a clean state. This recovery+  -- mechanism survives through different program executions, so even if a+  -- failure when running a migration in 'Normal' mode causes the whole program+  -- to crash, the corresponding 'Recovery' mode can still be run from the+  -- command line program. In fact, /moto/ will refuse making any other changes+  -- until this matter is sorted. For this reason, if let a 'Change' being+  -- executed in 'Normal' mode fails, it is always preferrable to let that+  -- exception propagate, and instead focus on writing any mitigating code as+  -- part of the 'Recovery' mode.+  | Recovery+  -- ^ An attempt to run the migration in the 'Direction' requested by+  -- the user has failed, so as a recovery meassure we are running the same+  -- migration in the opposite direction now. You can't make assumptions+  -- about the starting point, because running the migration in the desired+  -- 'Direction' failed somewhere in the middle of process. Please rely on the+  -- 'Backup' data you obtained before to decide how to correct the situation.+  --+  -- Ultimately, running a migration in 'Recovery' mode in a particular+  -- 'Direction' needs to accomplish the same outcome as running it in 'Normal'+  -- mode in that same 'Direction'.+  --+  -- If running a migration in 'Recovery' mode fails, then the program will exit+  -- and the migrations registry will be left in a dirty state, from which you+  -- can manually attempt to initiate a recovery again. At this point, reading+  -- the output logs and understanding what when wrong will be very useful:+  -- Maybe the migration failed because of a temporary phenomenon such as a+  -- network connectivity issue, in which simply retrying later will solve it,+  -- or maybe it failed because of a bug in the migration implementation, in+  -- which case logs will be crucial to understand how to change the migrations+  -- code in order to fix it.++instance Df1.ToValue Mode where+  value = \case+    Normal -> "normal"+    Recovery -> "recovery"++--------------------------------------------------------------------------------++-- | A 'Change' describes how a 'Mig' /changes/ the environment.+--+-- The given function will be called when running the migration both in+-- 'Forwards' or 'Backwards' direction.+--+-- In both cases, we have access to the original 'Backup' data while+-- running the migration, which implies that even “irrecoverable” migrations+-- that delete things when going 'Forwards' can be undone by relying on data+-- from the 'Backup'.+--+-- The given 'Mode' specifies why and how this 'Change' is being run.+-- Particularly, it describes the assumptions you can make about the+-- environment, which is very important if something goes wrong. Please refer to+-- the documentation for 'Mode' for a better understanding.+--+-- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+-- "Di.Df1"), but please don't log exceptions nor messages telling whether this+-- function as a whole succeeds or fails, since this library already does that+-- for you. However, for debugging purposes in case something goes wrong, it is+-- __very important__ that you log what your 'Change' is doing, particularly if+-- the changes themselves are not atomic. Please see the documentation for+-- 'Recovery' to understand what can be helpful.+--+-- After a successful 'Backwards' execution of this 'Change', any recovery data+-- associated with the 'Mig' previously obtained during the 'Backup' phase can+-- be deleted from its 'Store', since it is not necessary anymore. This will+-- happen automatically if you request so when instructing /moto/ to run your+-- migrations.+newtype Change x = Change (Di.Df1 -> Direction -> Mode -> x -> IO ())++-- | 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..."+  logException di1 (f di1 d m x)+     <* Di.info di1 "Ran."++--------------------------------------------------------------------------------++-- | A term-level identifier for a 'Mig'.+newtype MigId = MigId { unMigId :: T.Text }+  deriving newtype (Eq, Ord, Show, IsString, Read, Df1.ToValue)++-- | Hexadecimal representation of the SHA1 hash for this 'MigId'.+migId_sha1Hex :: MigId -> BL.ByteString+migId_sha1Hex+  = BB.toLazyByteString+  . BBP.primMapByteStringFixed BBP.word8HexFixed+  . SHA1.hash . T.encodeUtf8 . unMigId++--------------------------------------------------------------------------------++-- | The target to which to migrate.+data Target = Target Direction (Set MigId)+  deriving (Eq, Show)++--------------------------------------------------------------------------------++-- | A migrations execution plan.+data Plan = Plan Direction (Seq (MigId, UMig))+  -- ^ Unsafe constructor. The migrations are always listed in+  -- 'Forwards' order, even if intended to be run 'Backwards'.++-- | Obtain a migrations execution 'Plan' if possible.+mkPlan+  :: Migs graph -- ^ Avaiable migrations.+  -> [MigId]+  -- ^ Migration history represented as the 'MigId's that have already been+  -- run, in the 'Forwards' order they have been run.+  -> Target -- ^ Migration target.+  -> Either Err_Plan Plan+mkPlan (Migs []) [] (Target d []) = Right (Plan d [])+mkPlan (Migs m0) ran (Target d req0) = do+    -- If 'req0' mentions an unknown, we abort.+    case Set.difference req0 (Map.keysSet m0) of+      [] -> pure ()+      req1 -> Left (Err_Plan_TargetsNotFound req1)+    -- Find all topological orders.+    let topos0 :: [[MigId]]+        topos0 = topos (fmap fst m0)+    -- Find the topological orders that share the 'ran' prefix.+    case catMaybes (List.stripPrefix ran <$> topos0) :: [[MigId]] of+      [] -> Left Err_Plan_HistoryUnknown+      topos1 -> do+        -- Find the topological order to use.+        topo :: [MigId] <- direction (bw topos0) (fw topos1) d+        -- Add 'UMig' data and return.+        Right (Plan d (Seq.fromList (map (id &&& getUMig) topo)))+  where+    getUMig :: MigId -> UMig+    getUMig = \mId -> snd (m0 Map.! mId)+    isGone :: MigId -> Bool+    isGone = \mId -> case getUMig mId of { UGone -> True; _ -> False }+    fw :: [[MigId]] -> Either Err_Plan [MigId]+    fw [] = error "fw: unreachable"+    fw topos0@(topo0:_) = case req0 of+      [] ->+        -- No specific migration was requested, so we run everything not gone.+        case filter (all (not . isGone)) topos0 of+          [] -> Left (Err_Plan_TargetsGone (Set.fromList (filter isGone topo0)))+          (topo:_) -> Right topo+      _ ->+        -- We exclude from 'req0' whatever has been run already.+        case Set.difference req0 (Set.fromList ran) of+          [] -> Right [] -- Nothing to do. All of 'req0' has been run already.+          req1 -> do+            -- Our final topological order will be a permutation of 'req1'.+            let perms :: [[MigId]] = List.permutations (Set.toList req1)+            -- We will only run as many migrations as 'req1' asks, so we+            -- discard the rest to keep things simple below.+            let topos1 :: [[MigId]] = List.take (Set.size req1) <$> topos0+            -- Select topological orders that matches one of 'perms', if any.+            case filter (\topo -> any (== topo) perms) topos1 of+              [] -> Left Err_Plan_TargetImpossible+              topos2@(topo2:_) -> do+                -- Select a topological order with migrations not gone.+                case List.find (all (not . isGone)) topos2 of+                  Just topo -> Right topo+                  Nothing -> Left (Err_Plan_TargetsGone+                    (Set.fromList (filter isGone topo2)))+    bw :: [[MigId]] -> Either Err_Plan [MigId]+    bw [] = error "bw: unreachable"+    bw topos0@(_:_) = case req0 of+      [] ->+        -- No specific migration was requested, so we undo everything not gone.+        case filter isGone ran of+          [] -> Right ran+          xs -> Left (Err_Plan_TargetsGone (Set.fromList xs))+      _ ->+        -- We exclude from 'req0' whatever hasn't been run already.+        case Set.intersection req0 (Set.fromList ran) of+          [] -> Right [] -- Nothing to do. None of 'req0' has run yet.+          req1 -> do+            -- Our final topological order will be a permutation of 'req1'.+            let perms :: [[MigId]] = List.permutations (Set.toList req1)+            -- We remove the prefix or ran non-removeable migrations.+            let topos1 :: [[MigId]]+                topos1 = List.drop (length ran - Set.size req1) <$> topos0+            -- We will only undo as many migrations as 'req1' asks, so we+            -- discard the rest to keep things simple below.+            let topos2 :: [[MigId]] = List.take (Set.size req1) <$> topos1+            -- Select a topological order that matches one of 'perms', if any.+            case filter (\topo -> any (== topo) perms) topos2 of+              [] -> Left Err_Plan_TargetImpossible+              topos3@(topo3:_) ->+                 -- Select a topological order with migrations not gone.+                 case List.find (all (not . isGone)) topos3 of+                  --  Just topo -> Right (List.reverse topo) -- In forwards order.+                   Just topo -> Right topo+                   Nothing -> Left (Err_Plan_TargetsGone+                     (Set.fromList (filter isGone topo3)))++-- | Like 'mkPlan', but gets the history of ran migrations directly from the+-- 'Registry'.+getPlan+  :: Di.Df1+  -> Migs graph -- ^ Avaiable migrations.+  -> Registry -- ^ Registry representing the current migration history.+  -> Target -- ^ Migration target.+  -> IO (Either Err_Plan Plan)+getPlan di0 migs_ reg tgt = do+  state <- registry_state reg di0+  let ran = map fst (state_committed state)+  pure (mkPlan migs_ ran tgt)++--------------------------------------------------------------------------------++-- | A 'State' can be described as a list of 'Log's ordered chronologically (see+-- 'updateState').+data Log+  = Log_Prepare Time.UTCTime MigId Direction+  -- ^ A particular migration identified by 'MigId' is going to be executed in+  -- the specified 'Direction'.+  --+  -- This is the first commit in the two-phase commit approach to registering a+  -- migration as executed.+  --+  -- The time when this log entry was created is mentioned as well.+  | Log_Commit Time.UTCTime+  -- ^ The migration most recently prepared for execution with 'Log_Prepare' is+  -- being committed.+  --+  -- This is the second commit in the two-phase commit approach to registering a+  -- migration as executed.+  --+  -- The time when this log entry was created is mentioned as well.+  | Log_Abort Time.UTCTime+  -- ^ The migration most recently prepared for execution with 'Log_Prepare' is+  -- being aborted.+  --+  -- This undoes the first commit in the two-phase commit approach to+  -- registering a migration as executed.+  --+  -- The time when this log entry was created is mentioned as well.+  deriving (Eq, Show, Read)++--------------------------------------------------------------------------------++-- | Registry status.+data Status+  = Dirty MigId Direction+  -- ^ There is an uncommitted migration being run in the specified direction in+  -- the registry.+  | Clean+  -- ^ There are no uncommitted migrations in the registry.+  deriving (Eq, Show)++--------------------------------------------------------------------------------++-- | Internal 'State' of a 'Registry'.+--+-- Create with 'emptyState' and 'updateState'.+data State = State Status [(MigId, Time.UTCTime)]+  deriving (Eq, Show)++-- | Whether the registry is currently 'Dirty' or 'Clean'.+state_status :: State -> Status+state_status (State x _) = x++-- | Committed migrations, chronologically ordered, with the most recently+-- applied first last.+state_committed :: State -> [(MigId, Time.UTCTime)]+state_committed (State _ x) = List.reverse x++-- | A clean 'State' without any committed migrations.+emptyState :: State+emptyState = State Clean []++-- | Modify a 'State' by applying a 'Log' to it, if possible.+--+-- Use 'emptyState' as the initial state.+--+-- @+-- 'Data.Foldable.foldlM' 'updateState' 'emptyState'+--   :: 'Foldable' t+--   => t 'Log'+--   -> 'Either' 'Err_UpdateState' 'State'+-- @+updateState :: State -> Log -> Either Err_UpdateState State+updateState (State Clean xs) (Log_Prepare _ mId Forwards)+  | elem mId (map fst xs) = Left (Err_UpdateState_Duplicate mId)+  | otherwise = Right (State (Dirty mId Forwards) xs)+updateState (State Clean xs) (Log_Prepare _ mId Backwards)+  | elem mId (map fst xs) = Right (State (Dirty mId Backwards) xs)+  | otherwise = Left (Err_UpdateState_NotFound mId)+updateState (State Clean _) _+  = Left Err_UpdateState_Clean+updateState (State (Dirty mId Forwards) xs) (Log_Commit t)+  = Right (State Clean ((mId, t) : xs))+updateState (State (Dirty _ Forwards) xs) (Log_Abort _)+  = Right (State Clean xs)+updateState (State (Dirty mId Backwards) xs) (Log_Commit _)+  = Right (State Clean (filter (\(mId', _) -> mId' /= mId) xs))+updateState (State (Dirty _ Backwards) xs) (Log_Abort _)+  = Right (State Clean xs)+updateState (State (Dirty _ _) _) _+  = Left Err_UpdateState_Dirty++--------------------------------------------------------------------------------++-- | 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 ()+cleanRegistry di0 migs_ reg0 = do+  let reg = mkRegistrish reg0+  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."+        case lookupMigs mId migs_ of+           Nothing -> do+              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."+              Ex.throwM (Err_CleanRegistry_MigGone mId)+           Just (_, UMig (st :: Store x) _ (Change ch)) -> do+              store_load st di1 mId $ \x -> do+                 Ex.uninterruptibleMask $ \restore -> do+                    restore (ch di1 (opposite d1) Recovery x)+                    registrish_abort reg di1 mId d1++--------------------------------------------------------------------------------++run :: Di.Df1 -> Registry -> Plan -> IO ()+run di0 reg0 (Plan d0 s0) = do+  let reg = mkRegistrish reg0+  fmap state_status (registrish_state reg di0) >>= \case+     Dirty mId d1 -> Ex.throwM (Err_Run_Dirty mId d1)+     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+           when (d0 == Forwards) $ do+              ba di1 (store_save st di1 mId)+           -- If 'ioDelete' is 'True' when we finish processing our migration,+           -- then we will delete the data for 'mId' from the 'Store'.+           ioDelete :: IORef Bool <- newIORef False+           -- We run 'store_load' even if we already know what the recovery data+           -- is, to ensure that it can be loaded later in case of catastrophe.+           Ex.finally+              (store_load st di1 mId $ \x -> do+                  registrish_prepare reg di1 mId d0+                  Ex.uninterruptibleMask $ \restore -> do+                     Ex.onException+                        (restore (ch di1 d0 Normal x))+                        (do ch di1 (opposite d0) Recovery x+                            registrish_abort reg di1 mId d0+                            when (d0 == Forwards)+                                 (writeIORef ioDelete True))+                     registrish_commit reg di1 mId d0+                     when (d0 == Backwards)+                          (writeIORef ioDelete True))+              (readIORef ioDelete >>= \case+                  True -> store_delete st di1 mId+                  False -> pure ())++--------------------------------------------------------------------------------++-- | Migrations registry, keeping track of what migrations have been run so far,+-- as well as those that are running.+--+-- Consider using 'Moto.Registry.newAppendOnlyRegistry' as an easy way to+-- create a 'Registry'.+data Registry = Registry+  { registry_state :: Di.Df1 -> IO State+    -- ^ Current registry state.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but please don't log exceptions nor messages telling whether+    -- this function succeeds or fails, since this library already does that for+    -- you.+  , registry_prepare :: Di.Df1 -> MigId -> Direction+                     -> IO (Either Err_Prepare Log)+    -- ^ Register a new pending change in the registry.+    --+    -- Returns the 'Log_Prepare' that describes this change to the registry.+    --+    -- * This is the first commit in the two-phase commit mechanism to+    -- registering migrations as executed ('registry_commit' is the second).+    --+    -- * If 'Forwards', then the given 'MigId' shall be recorded in the+    -- registry as fully exceuted after a subsequent 'registry_commit'. If the+    -- given 'MigId' is already present and committed in the registry, then+    -- 'registry_prepare' shall return 'Err_Prepare_Duplicate'.+    --+    -- * If 'Backwards', then the given 'MigId', which must be already present+    -- and committed to the registry, will be removed from the list of currently+    -- committed migtrations after a subsequent 'registry_commit'.  If the+    -- 'MigId' is not already present and committed in the registry, then+    -- 'registry_prepare' shall return 'Err_Prepare_NotFound'.+    --+    -- * If there is already an uncommitted migration (that is, if the status is+    -- 'Dirty'), then 'Err_Prepare_Dirty' shall be returned. This constraint+    -- implies that it is impossible to have more than one pending change at a+    -- time.+    --+    -- * After a successful call to 'registry_prepare', the registry will be+    -- left in a 'Dirty' status until one of 'registry_commit' or+    -- 'registry_abort' is performed.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but don't log exceptions nor messages telling whether this+    -- function succeeds or fails, since this library already does that for you.+  , registry_abort :: Di.Df1 -> MigId -> Direction+                   -> IO (Either Err_Abort Log)+    -- ^ Abort the pending change in the given 'Direction' most recently+    -- introduced via 'registry_prepare', expected to be identified by the given+    -- 'MigId'.+    --+    -- Returns the 'Log_Abort' that describes this change to the registry.+    --+    -- If there is no pending change to be aborted (that is, if the status is+    -- 'Clean'), then 'Err_Abort_Clean' shall be returned.+    --+    -- If the currently pending migration's identifier is different from the+    -- the given 'MigId', or if its execution was intended for a 'Direction'+    -- different than the one specified here, then 'Err_Abort_Dirty' shall be+    -- returned.+    --+    -- After a successful call to 'registry_abort', the registry will be left+    -- in a 'Clean' status.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but don't log exceptions nor messages telling whether this+    -- function succeeds or fails, since this library already does that for you.+  , registry_commit :: Di.Df1 -> MigId -> Direction+                    -> IO (Either Err_Commit Log)+    -- ^ Commit the pending change in the given 'Direction' most recently+    -- introduced via 'registry_prepare', expected to be identified by the given+    -- 'MigId'.+    --+    -- Returns the 'Log_Commit' that describes this change to the registry.+    --+    -- This is the first commit in the two-phase commit mechanism to+    -- registering migrations as executed ('registry_prepare' is the first).+    --+    -- If there is no pending change to be committed (that is, if the status+    -- is 'Clean'), then 'Err_Commit_Clean' shall be returned.+    --+    -- If the currently pending migration's identifier is different from the+    -- the given 'MigId', or if its execution was intended for a 'Direction'+    -- different than the one specified here, then 'Err_Commit_Dirty' shall be+    -- returned.+    --+    -- After a successful call to 'registry_commit', the registry will be left+    -- in a 'Clean' status.+    --+    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and+    -- "Di.Df1"), but don't log exceptions nor messages telling whether this+    -- function succeeds or fails, since this library already does that for you.+  }++-- | This is just like 'Registry', except the 'Left' return values are+-- propagated as exceptions.+data Registrish = Registrish+  { registrish_state :: Di.Df1 -> IO State+  , registrish_prepare :: Di.Df1 -> MigId -> Direction -> IO ()+  , registrish_abort :: Di.Df1 -> MigId -> Direction -> IO ()+  , registrish_commit :: Di.Df1 -> MigId -> Direction -> IO ()+  }++-- | Add some extra logging to a 'Registry', and promote the many 'Left'+mkRegistrish :: Registry -> Registrish+mkRegistrish reg =+  let f :: Ex.Exception a => Either a b -> IO ()+      f = either Ex.throwM (const (pure ()))+  in Registrish+       { registrish_state = registry_state reg+       , registrish_prepare = \di0 mId d -> do+           let di1 = Di.push "registry" di0+           Di.debug di1 "Adding pending registry change..."+           logException di1 (f =<< registry_prepare reg di1 mId d)+           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..."+           logException di1 (f =<< registry_abort reg di1 mId d)+           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..."+           logException di1 (f =<< registry_commit reg di1 mId d)+           Di.debug di1 "Committed change to registry."+       }++--------------------------------------------------------------------------------+-- Various errors.++-- | A 'Log' representation was malformed and couldn't be parsed.+data Err_MalformedLog = Err_MalformedLog String deriving (Eq, Show)+instance Ex.Exception Err_MalformedLog++-- | Errors from 'mkPlan'.+data Err_Plan+  = Err_Plan_TargetsNotFound (Set MigId)+  -- ^ The targeted 'MigId's are not present in the migrations graph.+  | Err_Plan_HistoryUnknown+  -- ^ The specified migration history is not a known possibility according+  -- to the migrations dependency graph, meaning that it is not possible to+  -- add new migrations to it.+  | Err_Plan_TargetImpossible+  -- ^ It is not possible to obtain an execution plan given the requirements and+  -- dependency graph.+  | Err_Plan_TargetsGone (Set MigId)+  -- ^ Some migrations required to obtain an execution plan are 'Gone'.+  deriving (Eq, Show)+instance Ex.Exception Err_Plan++-- | Errors from 'cleanRegistry'.+--+-- By the time you receive these errors, they have already been logged.+data Err_CleanRegistry+  = Err_CleanRegistry_NotFoundInMigs MigId+  -- ^ The currently dirty 'MigId', as it appears in the 'Registry' records, is+  -- not present in the given 'Migs'.+  | Err_CleanRegistry_MigGone MigId+  -- ^ The code for the migration identfified 'MigId' is gone.+  deriving (Eq, Show)+instance Ex.Exception Err_CleanRegistry++-- | Errors from 'run'.+data Err_Run+  = Err_Run_Dirty MigId Direction+  -- ^ The migration registry has an unexpected pending migration.+  deriving (Eq, Show)+instance Ex.Exception Err_Run++-- | Errors from 'updateState'.+data Err_UpdateState+  = Err_UpdateState_Duplicate MigId+  | Err_UpdateState_NotFound MigId+  | Err_UpdateState_Clean+  | Err_UpdateState_Dirty+  deriving (Eq, Show)+instance Ex.Exception Err_UpdateState++-- | Errors from 'registry_prepare'.+data Err_Prepare+  = Err_Prepare_Duplicate MigId+  | Err_Prepare_NotFound MigId+  | Err_Prepare_Dirty MigId Direction+  deriving (Eq, Show)+instance Ex.Exception Err_Prepare++-- | Errors from 'registry_abort'.+data Err_Abort+  = Err_Abort_Clean+  | Err_Abort_Dirty MigId Direction+  deriving (Eq, Show)+instance Ex.Exception Err_Abort++-- | Errors from 'registry_commit'.+data Err_Commit+  = Err_Commit_Clean+  | Err_Commit_Dirty MigId Direction+  deriving (Eq, Show)+instance Ex.Exception Err_Commit++--------------------------------------------------------------------------------++-- | Get all the topological orders for the given acyclic graph, in+-- depth-first order.+--+-- Each node is represented as @k@, and the graph is represented as an+-- 'Map' from nodes to an 'Set' of nodes it depends on. For example, the graph+-- @1 <- 2 <- 3@ where @1@ must come before @2@ and @2@ must come before @3@ can+-- be represented as:+--+-- @+-- [(1,[]), (2,[1]), (3,[2])] :: 'Map' 'Int' ('Set' 'Int')+-- @+--+-- If there there are cycles in the graph, or if nodes depended upon are+-- missing, then @('mempty' :: 'Set')@ is returned.+--+-- If the given map is empty, then @('pure' [] :: 'Set')@ is returned.+--+-- The length of each @[k]@ equals the size of the given 'Map' (i.e.,+-- 'Map.size').+topos :: forall k. Ord k => Map k (Set k) -> [[k]]+topos [] = [[]]+topos m0 = go Set.empty m0+  where+    go :: Set k -> Map k (Set k) -> [[k]]+    go _  [] = [[]]+    go s0 m1 = do+      n <- Map.keys (Map.filter (\s1 -> s1 `Set.isSubsetOf` s0) m1)+      fmap (n:) (go (Set.insert n s0) (Map.delete n m1))++-- TODO write more of these, especially for well formed graphs.+-- prop_topos :: IntMap IntSet -> Bool+-- prop_topos m = all (\y -> length y == IntMap.size m) (topos m)++--------------------------------------------------------------------------------++-- | Runs the given action, and if some exception happens, then log it to the+-- 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!"+

@@ -0,0 +1,412 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# OPTIONS_HADDOCK hide #-}++module Moto.Internal.Cli+ ( RegistryConf(..)+ , Opts+ , getOpts+ , run+ ) where++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+import qualified System.IO as IO++import qualified Moto.Internal as I++--------------------------------------------------------------------------------++-- | Configuration for the 'I.Registry' that we'll use to keep track of the+-- migrations we've run so far.+data RegistryConf = forall r. RegistryConf+  { registryConf_help :: String+    -- ^ Help message for the @--registry@ command line option.+  , registryConf_parse :: String -> Either String r+    -- ^ Parse the string obtained from the @--registry@ command line option,+    -- 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+    -- ^ Given the @r@ obtained from 'registryConf_parse', get a 'I.Registry'+    -- that can be used within the given scope.+  }++--------------------------------------------------------------------------------++-- | Run the command-line arguments parser, obtaining the 'Opts' necessary for+-- calling 'run' afterwards.+--+-- Notice that we can run the executable that calls 'getOpts' with a @--help@+-- command line switch for extensive documentation on how to interact with+-- @moto@.+getOpts+  :: RegistryConf+  -- ^ Configuration for the 'I.Registry' to use.+  --+  -- Among other things, this will dictate how we interpret the @--registry@+  -- 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.+  -> OA.Parser a+  -- ^ This extra parser can be used to read some extra configuration+  -- values from the command-line arguments, besides @moto@'s own.+  --+  -- For example, we can obtain things such as the name of a configuration+  -- file or a database connection string we might want to use in our+  -- migrations.+  --+  -- If no such extra data is required, then @'pure' ()@ can be used.+  --+  -- Notice that @moto@'s own command-line argument's parser has precedence+  -- over this parser. Yet, in the command-line, the argument's for the parser+  -- for @a@ should come before @moto@'s own subcommand arguments, otherwise the+  -- command line program will complain about a malformed command-line.+  -> IO (Opts, a)+getOpts rc p_a = OA.customExecParser+   (OA.prefs (OA.showHelpOnEmpty <> OA.noBacktrack))+   (let pi0 = oa_pi_Opts rc+    in pi0 { OA.infoParser = (,) <$> OA.infoParser pi0 <*> p_a })++-- | Run @moto@ on the given migrations graph 'I.Migs', according to the+-- instructions in 'Opts'.+run+  :: Di.Df1+  -- ^ Root logger. If you don't have a 'Di.Df1' for your program yet, you can+  -- obtain one using @Di.new@ from the+  -- [di](https://hackage.haskell.org/package/di) library.+  -> I.Migs graph+  -- ^ Avaliable migrations graph.+  -> Opts+  -- ^ Instructions on how to interact with our migrations.+  -- Obtain with 'getOpts'.+  -> IO ()+run di0 migs opts = do+  case opts_sub opts of+     Sub_Run x -> run_Run di0 migs x+     Sub_ShowMigrations x -> run_ShowMigrations migs x+     Sub_CheckMigrations x -> run_CheckMigrations di0 migs x+     Sub_ShowRegistry x -> run_ShowRegistry di0 x+     Sub_CleanRegistry x -> run_CleanRegistry di0 migs x+     Sub_DeleteRecoveryData x -> run_DeleteRecoveryData di0 migs x++run_Run :: Di.Df1 -> I.Migs graph -> Opts_Run -> IO ()+run_Run di0 migs x = do+  runWithRegistry (opts_run_withRegistry x) $ \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+           False -> I.run di0 reg p+           True -> BB.hPutBuilder IO.stdout (renderPlan p)++run_ShowMigrations :: I.Migs graph -> Opts_ShowMigrations -> IO ()+run_ShowMigrations migs x = do+  let gf = opts_showMigrations_graphFormat x+  BB.hPutBuilder IO.stdout (renderMigs gf migs)++run_CheckMigrations :: Di.Df1 -> I.Migs graph -> Opts_CheckMigrations -> IO ()+run_CheckMigrations di0 migs x = do+  runWithRegistry (opts_checkMigrations_withRegistry x) $ \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+      Right _ -> IO.exitSuccess++run_ShowRegistry :: Di.Df1 -> Opts_ShowRegistry -> IO ()+run_ShowRegistry di0 x = do+  runWithRegistry (opts_showRegistry_withRegistry x) $ \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+    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 ()++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+    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."+        IO.exitFailure+      Nothing -> do+        Di.error di1 "Migration not unknown."+        IO.exitFailure++--------------------------------------------------------------------------------++oa_pi_Opts :: RegistryConf -> OA.ParserInfo Opts+oa_pi_Opts rc = OA.info+  (oa_p_Opts rc OA.<**> OA.helper)+  (OA.fullDesc <> OA.progDesc "Command line interface to migrations.")++oa_p_Opts :: RegistryConf -> OA.Parser Opts+oa_p_Opts rc = Opts <$> oa_p_Sub rc++-- | This is the input required by 'run', obtained from the command line+-- arguments by using 'getOpts'.+data Opts = Opts+  { opts_sub :: Sub+    -- ^ Subcommand to run.+  }++--------------------------------------------------------------------------------++oa_p_Sub :: RegistryConf -> OA.Parser Sub+oa_p_Sub rc = OA.hsubparser $ mconcat+  [ OA.command "run"+      (fmap Sub_Run (oa_pi_Run rc))+  , OA.command "show-migrations"+      (fmap Sub_ShowMigrations oa_pi_ShowMigrations)+  , OA.command "check-migrations"+      (fmap Sub_CheckMigrations (oa_pi_CheckMigrations rc))+  , OA.command "show-registry"+      (fmap Sub_ShowRegistry (oa_pi_ShowRegistry rc))+  , OA.command "clean-registry"+      (fmap Sub_CleanRegistry (oa_pi_CleanRegistry rc))+  , OA.command "delete-recovery-data"+      (fmap Sub_DeleteRecoveryData oa_pi_DeleteRecoveryData)+  ]++data Sub+  = Sub_Run Opts_Run+  -- ^ Run migrations.+  | Sub_ShowMigrations Opts_ShowMigrations+  -- ^ Show available migrations.+  | Sub_CheckMigrations Opts_CheckMigrations+  -- ^ Check that the available migrations are compatible with the registry.+  | Sub_ShowRegistry Opts_ShowRegistry+  -- ^ Show migrations registry.+  | Sub_CleanRegistry Opts_CleanRegistry+  -- ^ I.Clean the registry if dirty.+  | Sub_DeleteRecoveryData Opts_DeleteRecoveryData+  -- ^ Delete content from the store.++--------------------------------------------------------------------------------++oa_pi_Run :: RegistryConf -> OA.ParserInfo Opts_Run+oa_pi_Run rc = OA.info (oa_p_Run rc) (OA.progDesc "Run migrations.")++oa_p_Run :: RegistryConf -> OA.Parser Opts_Run+oa_p_Run rc = Opts_Run+  <$> oa_p_WithRegistry rc+  <*> oa_p_Target+  <*> OA.flag True False+        (OA.long "no-dry-run" <>+         OA.help "Don't just show the execution plan, run it!")++data Opts_Run = Opts_Run+  { opts_run_withRegistry :: WithRegistry+  -- ^ Acquire a 'I.Registry' to use within a limited scope..+  , opts_run_target :: I.Target+  -- ^ Migration target.+  , opts_run_dryRun :: Bool+  -- ^ Don't run migrations, just show the execution plan.+  }++--------------------------------------------------------------------------------++oa_pi_ShowMigrations :: OA.ParserInfo Opts_ShowMigrations+oa_pi_ShowMigrations = OA.info oa_p_ShowMigrations+  (OA.progDesc "Show available migrations.")++oa_p_ShowMigrations :: OA.Parser Opts_ShowMigrations+oa_p_ShowMigrations = Opts_ShowMigrations <$> oa_p_GraphFormat++data Opts_ShowMigrations = Opts_ShowMigrations+  { opts_showMigrations_graphFormat :: GraphFormat+  -- ^ Format in which to render the migrations graph.+  }++--------------------------------------------------------------------------------++oa_pi_CheckMigrations :: RegistryConf -> OA.ParserInfo Opts_CheckMigrations+oa_pi_CheckMigrations rc = OA.info (oa_p_CheckMigrations rc)+  (OA.progDesc "Exit immediately with status 0 if the available \+               \migrations are compatible with the registry. \+               \Otherwise, exit with status 1.")++oa_p_CheckMigrations :: RegistryConf -> OA.Parser Opts_CheckMigrations+oa_p_CheckMigrations rc = Opts_CheckMigrations <$> oa_p_WithRegistry rc++data Opts_CheckMigrations = Opts_CheckMigrations+  { opts_checkMigrations_withRegistry :: WithRegistry+  -- ^ Acquire a 'I.Registry' to use within a limited scope..+  }++--------------------------------------------------------------------------------++oa_pi_ShowRegistry :: RegistryConf -> OA.ParserInfo Opts_ShowRegistry+oa_pi_ShowRegistry rc = OA.info+  (oa_p_ShowRegistry rc)+  (OA.progDesc "Show migrations registry.")++oa_p_ShowRegistry :: RegistryConf -> OA.Parser Opts_ShowRegistry+oa_p_ShowRegistry rc = Opts_ShowRegistry <$> oa_p_WithRegistry rc++data Opts_ShowRegistry = Opts_ShowRegistry+  { opts_showRegistry_withRegistry :: WithRegistry+  -- ^ Acquire a 'I.Registry' to use within a limited scope..+  }++--------------------------------------------------------------------------------++oa_pi_CleanRegistry :: RegistryConf -> OA.ParserInfo Opts_CleanRegistry+oa_pi_CleanRegistry rc = OA.info+  (oa_p_CleanRegistry rc)+  (OA.progDesc "Clean a dirty migrations registry.")++oa_p_CleanRegistry :: RegistryConf -> OA.Parser Opts_CleanRegistry+oa_p_CleanRegistry rc = Opts_CleanRegistry+  <$> oa_p_WithRegistry rc+  <*> OA.switch (OA.long "dry-run" <>+                 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.")++data Opts_CleanRegistry = Opts_CleanRegistry+  { opts_cleanRegistry_withRegistry :: WithRegistry+  -- ^ 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.+  }++--------------------------------------------------------------------------------++oa_pi_DeleteRecoveryData :: OA.ParserInfo Opts_DeleteRecoveryData+oa_pi_DeleteRecoveryData = OA.info oa_p_DeleteRecoveryData+  (OA.progDesc "Delete contents from the migrations data store.")++oa_p_DeleteRecoveryData :: OA.Parser Opts_DeleteRecoveryData+oa_p_DeleteRecoveryData = Opts_DeleteRecoveryData+  <$> fmap Set.fromList (OA.some (OA.option OA.str (OA.long "mig")))++data Opts_DeleteRecoveryData = Opts_DeleteRecoveryData+  { opts_store_migIds :: Set.Set I.MigId+  -- ^ 'I.MigId's for which to remove contents from the data store.+  }++--------------------------------------------------------------------------------++data WithRegistry = WithRegistry+  { runWithRegistry :: forall a. (I.Registry -> IO a) -> IO a }++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_p_Target :: OA.Parser I.Target+oa_p_Target = I.Target+  <$> OA.flag I.Forwards I.Backwards (OA.long "backwards")+  <*> fmap Set.fromList (OA.many (OA.option OA.str+        (OA.long "mig" <> OA.metavar "ID" <>+         OA.help "If specified, only consider running the migration identified \+                 \by this ID. Use multiple times for multiple migrations.")))++--------------------------------------------------------------------------------++oa_p_GraphFormat :: OA.Parser GraphFormat+oa_p_GraphFormat =+  OA.flag GraphFormatText GraphFormatDot+    (OA.long "dot" <> OA.help "Render graph in DOT (Graphviz) format.")++data GraphFormat+  = GraphFormatText -- ^ Render as plain text.+  | GraphFormatDot -- ^ Render as DOT (Graphviz).++renderMigs :: GraphFormat -> I.Migs graph -> BB.Builder+renderMigs = \case+  GraphFormatText -> renderMigs_Text+  GraphFormatDot -> renderMigs_Dot++renderMigs_Text :: I.Migs graph -> BB.Builder+renderMigs_Text (I.Migs m0) = mconcat $ do+   (here, deps) <- Map.toList (fmap (toList . fst) m0)+   case deps of+     [] -> [ f here <> " has no dependencies.\n" ]+     _  -> [ f here <> " depends on:\n" <>+             mconcat (map (\mId -> "  * " <> f mId <> "\n") deps) ]+ where+   f :: I.MigId -> BB.Builder+   f (I.MigId x) = T.encodeUtf8Builder (T.pack (show x))++renderMigs_Dot :: I.Migs graph -> BB.Builder+renderMigs_Dot (I.Migs m0) = mconcat+   [ "digraph G {\n"+   , mconcat $ do+       (here, deps) <- Map.toList (fmap (toList . fst) m0)+       dep <- deps+       [ "  " <> f dep <> " -> " <> f here <> ";\n" ]+   , "}\n"+   ]+ where+   f :: I.MigId -> BB.Builder+   f (I.MigId x) = T.encodeUtf8Builder (T.pack (show x))++--------------------------------------------------------------------------------++renderState :: I.State -> BB.Builder+renderState s =+  "Status: " <> fromString (show (I.state_status s)) <>+  "\nCommitted migrations: " <>+  fromString (show (length (I.state_committed s))) <> "\n" <>+  mconcat (map (\x -> "  " <> fromString (show x) <> "\n")+               (I.state_committed s))++--------------------------------------------------------------------------------++-- | Renders each 'MigId' in the 'Plan' preceded by its direction, and followed+-- by a trailing newline.+renderPlan :: I.Plan -> BB.Builder+renderPlan (I.Plan _ []) = "Execution plan is empty. Nothing to do.\n"+renderPlan (I.Plan d s) = mconcat+    [ "Execution plan:\n"+    , mconcat (map (\(mId,_) -> "  Run " <> d' <> f mId <> "\n") (toList s))+    , "\nTo actually run the migrations, add --no-dry-run to "+    , "the command-line arguments.\n" ]+  where+    d' :: BB.Builder+    d' = I.direction "backwards " "forwards " d+    f :: I.MigId -> BB.Builder+    f (I.MigId x) = T.encodeUtf8Builder (T.pack (show x))+

@@ -0,0 +1,115 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}++-- | This module exports tools for implementing a registry that @moto@ can use+-- in order to keep track of the migrations that have been run so far.+--+-- It's unlikely that you'll need to concern yourself with this module as an+-- end user of @moto@.+--+-- Please import as:+--+-- @+-- import qualified "Moto.Registry" as Moto+-- @+module Moto.Registry+ ( -- * Command-line support+   IC.RegistryConf(..)++   -- * Registry+ , I.Registry(..)+ , newAppendOnlyRegistry++   -- * State+ , I.State+ , I.emptyState+ , I.updateState+ , I.Log(..)++   -- * Errors+ , Err_Tainted(..)+ , I.Err_Prepare(..)+ , I.Err_Abort(..)+ , I.Err_Commit(..)+ , I.Err_UpdateState(..)+ ) where++import Control.Concurrent (readMVar, putMVar, takeMVar, newMVar)+import qualified Control.Exception.Safe as Ex+import qualified Data.Time as Time++import qualified Moto.Internal as I+import qualified Moto.Internal.Cli as IC++--------------------------------------------------------------------------------++-- | Create a 'I.Registry' backed by an append-only 'I.Log' storage.+--+-- This registry maintains its internal 'I.State' in memory as long as it is+-- possible to successfuly store all the changes in the underlying append-only+-- storage. If at some point this fails unrecoverably, then 'Err_Tainted' will+-- be thrown by the functions acting on this 'I.Registry'.+--+-- It's important to acquire some kind of exclusive lock on the underlying+-- storage, so that other applications can't poke it while our 'I.Registry' is+-- running.+newAppendOnlyRegistry+  :: I.State+  -- ^ Initial registry state obtained by reading 'I.Log's from the backing+  -- append-only storage and running 'I.updateState' on them.+  -> (I.Log -> IO ())+  -- ^ How to store a newly generated 'I.Log' in the backing append-only+  -- storage.+  --+  -- If this function throws an exception, then the execption will propagated+  -- as usual, but also, this registry will be marked as tained and each+  -- subsequent operation on it will throw 'Err_Tainted'.+  -> IO I.Registry+newAppendOnlyRegistry !state0 putLog = do+  mvState <- newMVar (Just state0)+  let supdate :: (I.State -> Either e I.Log) -> IO (Either e I.Log)+      supdate f = Ex.bracketOnError+        (takeMVar mvState)+        (\_ -> putMVar mvState Nothing)+        (\case Nothing -> Ex.throwM Err_Tainted+               Just s0 -> case f s0 of+                 Left e -> pure (Left e)+                 Right log_ -> case I.updateState s0 log_ of+                   Left e -> Ex.throwM e -- This is unreachable code.+                   Right !s1 -> do+                     putLog log_+                     putMVar mvState (Just s1)+                     pure (Right log_))+  pure $ I.Registry+    { I.registry_state = \_ -> do+        maybe (Ex.throwM Err_Tainted) pure =<< readMVar mvState+    , I.registry_prepare = \_ mId d -> do+        t <- Time.getCurrentTime+        supdate $ \s -> case I.state_status s of+           I.Dirty mId' d' -> Left (I.Err_Prepare_Dirty mId' d')+           I.Clean -> case (d, elem mId (map fst (I.state_committed s))) of+             (I.Forwards, True) -> Left (I.Err_Prepare_Duplicate mId)+             (I.Backwards, False) -> Left (I.Err_Prepare_NotFound mId)+             _ -> Right (I.Log_Prepare t mId d)+    , I.registry_abort = \_ mId d -> do+        t <- Time.getCurrentTime+        supdate $ \s -> case I.state_status s of+           I.Clean -> Left I.Err_Abort_Clean+           I.Dirty mId' d'+             | mId /= mId' || d /= d' -> Left (I.Err_Abort_Dirty mId' d')+             | otherwise -> Right (I.Log_Abort t)+    , I.registry_commit = \_ mId d -> do+        t <- Time.getCurrentTime+        supdate $ \s -> case I.state_status s of+           I.Clean -> Left I.Err_Commit_Clean+           I.Dirty mId' d'+             | mId /= mId' || d /= d' -> Left (I.Err_Commit_Dirty mId' d')+             | otherwise -> Right (I.Log_Commit t)+    }++-- | The 'I.Registry' is tainted, meaning our last attempt to interact with the+-- registry's backing storage failed. We can't be certain about the current+-- state of the 'I.Registry'.+data Err_Tainted = Err_Tainted deriving (Eq, Show)+instance Ex.Exception Err_Tainted+

@@ -0,0 +1,114 @@+{- $cli_help++This is the full description of the command line options supported by+'Moto.getOpts', using @Moto.File.fileRegistry@ as the registry.++Main program (here called @moto-example@):++@+Usage: moto-example COMMAND+  Command line interface to migrations.++Available options:+  -h,--help                Show this help text++Available commands:+  run                      Run migrations.+  show-migrations          Show available migrations.+  check-migrations         Exit immediately with status 0 if the available+                           migrations are compatible with the registry.+                           Otherwise, exit with status 1.+  show-registry            Show migrations registry.+  clean-registry           Clean a dirty migrations registry.+  delete-recovery-data     Delete contents from the migrations data store.+@++++Subcommand @run@:++@+Usage: moto-example run --registry URI [--backwards] [--mig ID] [--no-dry-run]+  Run migrations.++Available options:+  --registry URI           File where registry file is stored. E.g.,+                           file:\/\/\/var\/db\/migrations+  --mig ID                 If specified, only consider running the migration+                           identified by this ID. Use multiple times for+                           multiple migrations.+  --no-dry-run             Don't just show the execution plan, run it!+  -h,--help                Show this help text+@++++Subcommand @show-migrations@:++@+Usage: moto-example show-migrations [--dot]+  Show available migrations.++Available options:+  --dot                    Render graph in DOT (Graphviz) format.+  -h,--help                Show this help text+@++++Subcommand @check-migrations@:++@+Usage: moto-example check-migrations --registry URI+  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+  -h,--help                Show this help text+@++++Subcommand @show-registry@:++@+Usage: moto-example show-registry --registry URI+  Show migrations registry.++Available options:+  --registry URI           File where registry file is stored. E.g.,+                           file:\/\/\/var\/db\/migrations+  -h,--help                Show this help text+@++++Subcommand @clean-registry@:++@+Usage: moto-example clean-registry --registry URI [--dry-run]+  Clean a dirty migrations registry.++Available options:+  --registry URI           File where registry file is stored. E.g.,+                           file:\/\/\/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.+  -h,--help                Show this help text+@++++Subcommand @delete-recovery-data@:++@+Usage: moto-example delete-recovery-data --mig ARG+  Delete contents from the migrations data store.++Available options:+  -h,--help                Show this help text+@+-}

@@ -1,1062 +0,0 @@-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StrictData #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE UndecidableSuperClasses #-}--module Moto.Internal- ( run-- -- * Describing migrations- , Mig(Mig, Gone)- , UMig(UMig, UGone)- -- ** Backup- , Backup(Backup)- -- ** Change- , Change(Change)- -- ** Store- , Store(Store, store_save, store_load, store_delete)- , mapStore--  -- *** Direction- , Direction(Backwards, Forwards)- , direction- , opposite-- -- *** Mode- , Mode(Normal, Recovery)-- -- * Execution plan- , Migs(Migs)- , migs- , (Moto.Internal.*)- , DAG- , lookupMigs-- , Target(..)-- , Plan(Plan)- , mkPlan- , getPlan-- , MigId(MigId, unMigId)- , migId- , migId_sha1Hex-- -- * Registry- , Registry(..)- , cleanRegistry-- -- * State- , State- , state_status- , state_committed- , emptyState- , updateState- , Status(..)- , Log(..)-- -- * Errors- , Err_Run(..)- , Err_Plan(..)- , Err_Prepare(..)- , Err_Abort(..)- , Err_Commit(..)- , Err_UpdateState(..)- , Err_MalformedLog(..)- ) where--import Control.Arrow ((&&&))-import Control.Monad (when)-import qualified Control.Exception.Safe as Ex-import Control.Monad.IO.Class (MonadIO)-import qualified Crypto.Hash.SHA1 as SHA1-import qualified Data.ByteString.Builder as BB-import qualified Data.ByteString.Builder.Prim as BBP-import qualified Data.ByteString.Lazy as BL-import Data.Foldable (for_)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import qualified Data.List as List-import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map-import Data.Maybe (catMaybes)-import Data.Proxy (Proxy(..))-import Data.Sequence (Seq)-import qualified Data.Sequence as Seq-import Data.Set (Set)-import qualified Data.Set as Set-import Data.String (IsString, fromString)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Time as Time-import qualified Df1-import qualified Di.Df1 as Di-import GHC.Exts (Constraint)-import GHC.TypeLits (KnownSymbol, symbolVal, Symbol)-import qualified GHC.TypeLits as GHC-import qualified System.Mem-------------------------------------------------------------------------------------- | The directed acyclic graph of migrations available for execution.------ Construct using 'Moto.migs' and 'Moto.*'. For example:------ @--- 'Moto.migs' 'Moto.*' someMig 'Moto.*' anotherMig 'Moto.*' ...--- @-newtype Migs (graph :: [(Symbol, [Symbol])])-  = Migs (Map MigId (Set MigId, UMig))-  -- ^ Unsafe constructor. A map from 'MigId's, to the 'UMig' identfified by it,-  -- as well as a set of all of the 'MigId's that must be executed before it.---- | An empty, yet valid, graph of migrations.------ You can use 'Moto.migs' as a starting point for constructing bigger--- migrations graphs. For example:------ @--- 'Moto.migs' 'Moto.*' someMig 'Moto.*' anotherMig 'Moto.*' ...--- @-migs :: Migs '[]-migs = Migs Map.empty---- | Add a new migration with an unique identifier @id@ depending on each of--- @deps@ to a graph of migrations @graph@.------ The 'DAG' constraint guarantees that the result is a directed acyclic graph.------ To create a 'Migs' from scratch, use 'Moto.*' in combination with--- 'Moto.migs'. For example:------ @--- 'Moto.migs' 'Moto.*' someMig 'Moto.*' anotherMig 'Moto.*' ...--- @-infixl 7 *-(*) :: DAG id deps graph-    => Migs graph-    -> Mig id deps-    -- ^ @id@ must not be present in @graph@.-    ---    -- All of @deps@ must be present in @graph@.-    -> Migs ('(id, deps) ': graph)-(*) (Migs m) (mig :: Mig id deps) =-  let umig = case mig of-        Mig s b c -> UMig (pimpStore s) (pimpBackup b) (pimpChange c)-        Gone -> UGone-  in Migs (Map.insert (migId (Proxy :: Proxy id))-                      (Set.fromList (migIds (Proxy :: Proxy deps)), umig)-                      m)---- | This 'Constraint' is automatically satisfied by an @id@ that is absent from--- @graph@, and @deps@ listing identifiers present in the given @graph@.------ In other words, 'DAG' effectively forces 'Moto.*' to always build Directed--- Acyclic Graphs (hence the name).------ @--- 'DAG' id deps graph :: 'Constraint'--- @-type DAG id deps graph = DAG_ id deps graph---- | We don't export this to keep the haddocks clean.-type DAG_ (id :: Symbol) (deps :: [Symbol]) (graph :: [(Symbol, [Symbol])])-  = ( NotMember id deps-    , NotMember id (Ids graph)-    , Subset deps (Ids graph)-    -- The following two constraints have nothing to do with DAGs, but by-    -- putting them here we can keep the type of 'Moto.*' less noisy.-    , KnownSymbol id-    , KnownSymbols deps-    )---- | Obtain a term-level representation of a migration identifier from its--- type-level representation as a 'Symbol' (as it appears in the @id@ type--- parameter to 'Mig').-migId :: KnownSymbol id => Proxy id -> MigId-migId = MigId . fromString . symbolVal---- | Obtain a term-level representation of some migration identifiers from their--- type-level representation as @['Symbol']@ (as they appear in the @id@ type--- parameter to 'Mig').-migIds :: KnownSymbols ids => Proxy ids -> [MigId]-migIds = map (MigId . fromString) . symbolVals--lookupMigs :: MigId -> Migs graph -> Maybe (Set MigId, UMig)-lookupMigs mId (Migs m) = Map.lookup mId m--class All KnownSymbol ids => KnownSymbols (ids :: [Symbol]) where-  symbolVals :: Proxy ids -> [String]-instance KnownSymbols '[] where-  symbolVals _ = []-instance (KnownSymbol id, KnownSymbols ids) => KnownSymbols (id ': ids) where-  symbolVals (_ :: Proxy (id ': ids))-    = symbolVal (Proxy :: Proxy id)-    : symbolVals (Proxy :: Proxy ids)--type family All (f :: k -> Constraint) (as :: [k]) :: Constraint where-  All _ '[] = ()-  All f (a ': as) = (f a, All f as)--type family Subset (small :: [k]) (big :: [k]) :: Constraint where-  Subset '[] _ = ()-  Subset (a ': as) bs = (Member a bs, Subset as bs)--type family Ids (abs :: [(ka,kb)]) :: [ka] where-  Ids '[] = '[]-  Ids ( '(a,_) ': abs ) = (a ': Ids abs)--type Member (a :: k) (as :: [k]) = Member_ a as (IsMember a as)-type family Member_ (a :: k) (as :: [k]) (found :: Bool) :: Constraint where-  Member_ _ _ 'True = ()-  Member_ a as 'False = GHC.TypeError-    ('GHC.ShowType a 'GHC.:<>:-     'GHC.Text " is not a member of " 'GHC.:<>:-     'GHC.ShowType as)--type NotMember (a :: k) (as :: [k]) = NotMember_ a as (IsMember a as)-type family NotMember_ (a :: k) (as :: [k]) (found :: Bool) :: Constraint where-  NotMember_ _ _ 'False = ()-  NotMember_ a as 'True = GHC.TypeError-    ('GHC.ShowType a 'GHC.:<>:-     'GHC.Text " is a member of " 'GHC.:<>:-     'GHC.ShowType as)--type family IsMember (a :: k) (as :: [k]) :: Bool where-  IsMember _ '[] = 'False-  IsMember a (a ': _) = 'True-  IsMember a (b ': as) = IsMember a as-------------------------------------------------------------------------------------- | Direction in which a migration runs.------ Running it 'Forwards' conveys the idea of “advancing” or “improving” your--- state over time somehow, while running it 'Backwards' conveys the idea of--- undoing all the changes that the migration does when going 'Forwards'.-data Direction = Backwards | Forwards-  deriving stock (Eq, Ord, Show, Read)---- | Case analysis for 'Direction'. Evaluate to the first @a@ in case it is--- 'Backwards', otherwise to the second @a@.-direction :: a -> a -> Direction -> a-direction bw fw = \case { Backwards -> bw; Forwards -> fw }---- | The opposite of the given direction.-opposite :: Direction -> Direction-opposite = direction Forwards Backwards--instance Df1.ToValue Direction where-  value = direction "backwards" "forwards"-------------------------------------------------------------------------------------- | A single side-effecting migration uniquely identfied by @id@ and depending--- on all of the migrations listed in @deps@.------ These migration identifiers that appear as type-level 'Symbol' here, will be--- of type 'MigId' when represented at the type level.-data Mig (id :: Symbol) (deps :: [Symbol]) where-  -- | Description of the different phashes that make up this migration-  -- identified by @id@, depending on others identified by @deps@.-  Mig :: Store x-      -- ^ How to save and load data obtained during the 'Backup' phase when-      -- necessary.-      ---      -- Please note that you can reuse this same 'Store' across different-      -- migrations.-      ---      -- Any stored data will remain in the 'Store' until it is not necessary-      -- anymore (but it can be manually deleted if desired, at your own risk).-      ---      -- Please refer to 'Store' for further documentation.-      -> Backup x-      -- ^ Backup phase of this migration-      ---      -- This phase is executed only once when trying to run the migration-      -- 'Forwards' for the first time.-      ---      -- Please refer to 'Backup' for further documentation.-      -> Change x-      -- ^ Change phase of this migration.-      ---      -- This phase is executed both when going 'Forwards' and 'Backwards'. Here-      -- we alter the environment somehow while having access to the @x@ data-      -- obtained in the 'Backup' phase.-      ---      -- Please refer to 'Change' for further documentation.-      -> Mig id deps--  -- | This constructor conveys the idea that code for a particular migration is-  -- gone, while still communicating the dependencies that this migration used-  -- to have so that we don't change the past dependency graph over time, which-  -- would make it impossible for @moto@ to operate reliably.-  Gone :: Mig id deps---- | Internal. Like 'Mig', but without the type level data.-data UMig where-  UGone :: UMig-  UMig :: Store x -> Backup x -> Change x -> UMig-------------------------------------------------------------------------------------- | The backup phase of a migration, collecting some data @x@ for backup in a--- 'Store'.------ Here we interact with the environment in a /read-only/ manner, collecting all--- data that may be destroyed by a subsequent 'Change' phase for backup in some--- 'Store'.------ This data will be crucial for automatic recovery in case the 'Change' phase--- of the 'Mig' that uses this 'Backup' fails, or in case we manually decide to--- undo said 'Mig' at a later time. Thus, when deciding what data to return as--- @x@, please consider those scenarios.------ The actual storing of the backup data is performed by the 'Store' that is--- used as part of the same 'Mig'. That is, we don't physically store--- the data within this 'Backup', all we do is return it as @x@.------ Please keep in mind that depending on your environment, @x@ could be really--- large, so in those situations it best for @x@ to be some kind of /stream/--- (e.g., a 'Pipes.Producer').------ Notice that @x@ is returned in a continuation-passing style so that we can--- do proper resource deallocation after @x@ has been consumed. Using @x@--- outside of this intended scope is undefined.-data Backup (x :: *) = Backup (forall r. Di.Df1 -> (x -> IO r) -> IO r)---- | 'Backup' is covariant with @x@.-instance Functor Backup where-  fmap f (Backup g) = Backup (\di k -> g di (k . f))---- | Add some extra logging to a 'Backup'.-pimpBackup :: Backup x -> Backup x-pimpBackup (Backup f) = Backup $ \di0 k -> do-  let di1 = Di.push "backup" di0-  Di.debug di1 "Running..."-  r <- logException di1 (f di1 k)-  Di.debug di1 "Ran."-  -- Bonus track: Run GC to ensure we don't keep @x@ in memory.-  System.Mem.performMajorGC-  pure r-------------------------------------------------------------------------------------- | A 'Store' describes how to save, load and delete the @x@ data obtained by--- a 'Backup'.------ This @x@ data is used later by the 'Change' phase.------ A single 'Store' might be used by different 'Mig's.------ Hint: 'Moto.File.store' from the "Moto.File" module is a 'Store' you can use--- that's distributed with the main @moto@ library.-data Store (x :: *) = Store-  { store_save :: Di.Df1 -> MigId -> x -> IO ()-    -- ^ Saves the @x@ data originating from a 'Backup' step for a migration-    -- identified by 'MigId', __overwriting__ previous data if any.-    ---    -- If it's not possible to save the @x@ data, then this function must-    -- fail with some exception.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but please don't log exceptions nor messages telling whether-    -- this function succeeds or fails, since this library already does that for-    -- you.-  , store_load :: forall r. Di.Df1 -> MigId -> (x -> IO r) -> IO r-    -- ^ Load the data previously saved by 'store_save', for a migration-    -- identified by the given 'MigId'.-    ---    -- Notice that @x@ is returned in a continuation-passing style so that we-    -- can do proper resource deallocation after @x@ has been consumed. Using-    -- @x@ outside of this intended scope is undefined.-    ---    -- If it's was not possible to load the @x@ data, then this function must-    -- fail with some exception.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but please don't log exceptions nor messages telling whether-    -- this function succeeds or fails, since this library already does that for-    -- you.-  , store_delete :: Di.Df1 -> MigId -> IO ()-    -- ^ Delete the data previously saved by 'store_save', if any. for a-    -- migration identified by the given 'MigId'.-    ---    -- If it's there was no data to delete, then this function should return-    -- @()@. On the other hand, if its acceptable to throw exceptions when-    -- it's not possible to access the underlying storage.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but please don't log exceptions nor messages telling whether-    -- this function succeeds or fails, since this library already does that for-    -- you.-  }---- | Given isomorpisms between @a@ and @b@, obtain an function from--- @'Store' a@ and @'Store' b@.------ A @'Store' x@ is both covariant and contravariant with @x@.------ This function respects the functor laws.-mapStore-  :: (b -> a) -- ^ Isomorphism from @b@ to @a@.-  -> (a -> b) -- ^ Isomorphism from @a@ to @b@.-  -> Store a-  -> Store b-mapStore ba ab = \(Store s l d) ->-  Store (\di mId b -> s di mId (ba b))-        (\di mId kb -> l di mId (kb . ab))-        d---- | Add some extra logging to a 'Store'.-pimpStore :: Store a -> Store a-pimpStore sto = sto-  { store_save = \di0 mId x -> do-     let di1 = Di.push "save" di0-     Di.debug di1 "Saving recovery data..."-     logException di1 (store_save sto di1 mId x)-     Di.debug di1 "Saved."-  , store_load = \di0 mId k -> do-     let di1 = Di.push "load" di0-     Di.debug di1 "Loading recovery data..."-     r <- logException di1 (store_load sto di1 mId k)-     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..."-     r <- logException di1 (store_delete sto di1 mId)-     Di.info di1 "Deleted."-     pure r-  }-------------------------------------------------------------------------------------- | Execution mode of a migration, describing why and how a 'Change' migration--- is being run.-data Mode-  = Normal-  -- ^ The migration is being run as requested by the user, in the requested-  -- 'Direction'. Every previous step until now has run successfully. You can-  -- assume a clean starting point.-  ---  -- If running the migration in 'Normal' mode fails, the same migration will be-  -- run again in 'Recovery' mode /in the opposite 'Direction'/ as a way to-  -- undo any partial changes and go back to having a clean state. This recovery-  -- mechanism survives through different program executions, so even if a-  -- failure when running a migration in 'Normal' mode causes the whole program-  -- to crash, the corresponding 'Recovery' mode can still be run from the-  -- command line program. In fact, /moto/ will refuse making any other changes-  -- until this matter is sorted. For this reason, if let a 'Change' being-  -- executed in 'Normal' mode fails, it is always preferrable to let that-  -- exception propagate, and instead focus on writing any mitigating code as-  -- part of the 'Recovery' mode.-  | Recovery-  -- ^ An attempt to run the migration in the 'Direction' requested by-  -- the user has failed, so as a recovery meassure we are running the same-  -- migration in the opposite direction now. You can't make assumptions-  -- about the starting point, because running the migration in the desired-  -- 'Direction' failed somewhere in the middle of process. Please rely on the-  -- 'Backup' data you obtained before to decide how to correct the situation.-  ---  -- Ultimately, running a migration in 'Recovery' mode in a particular-  -- 'Direction' needs to accomplish the same outcome as running it in 'Normal'-  -- mode in that same 'Direction'.-  ---  -- If running a migration in 'Recovery' mode fails, then the program will exit-  -- and the migrations registry will be left in a dirty state, from which you-  -- can manually attempt to initiate a recovery again. At this point, reading-  -- the output logs and understanding what when wrong will be very useful:-  -- Maybe the migration failed because of a temporary phenomenon such as a-  -- network connectivity issue, in which simply retrying later will solve it,-  -- or maybe it failed because of a bug in the migration implementation, in-  -- which case logs will be crucial to understand how to change the migrations-  -- code in order to fix it.--instance Df1.ToValue Mode where-  value = \case-    Normal -> "normal"-    Recovery -> "recovery"-------------------------------------------------------------------------------------- | A 'Change' describes how a 'Mig' /changes/ the environment.------ The given function will be called when running the migration both in--- 'Forwards' or 'Backwards' direction.------ In both cases, we have access to the original 'Backup' data while--- running the migration, which implies that even “irrecoverable” migrations--- that delete things when going 'Forwards' can be undone by relying on data--- from the 'Backup'.------ The given 'Mode' specifies why and how this 'Change' is being run.--- Particularly, it describes the assumptions you can make about the--- environment, which is very important if something goes wrong. Please refer to--- the documentation for 'Mode' for a better understanding.------ The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and--- "Di.Df1"), but please don't log exceptions nor messages telling whether this--- function as a whole succeeds or fails, since this library already does that--- for you. However, for debugging purposes in case something goes wrong, it is--- __very important__ that you log what your 'Change' is doing, particularly if--- the changes themselves are not atomic. Please see the documentation for--- 'Recovery' to understand what can be helpful.------ After a successful 'Backwards' execution of this 'Change', any recovery data--- associated with the 'Mig' previously obtained during the 'Backup' phase can--- be deleted from its 'Store', since it is not necessary anymore. This will--- happen automatically if you request so when instructing /moto/ to run your--- migrations.-newtype Change x = Change (Di.Df1 -> Direction -> Mode -> x -> IO ())---- | 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..."-  logException di1 (f di1 d m x)-     <* Di.info di1 "Ran."-------------------------------------------------------------------------------------- | A term-level identifier for a 'Mig'.-newtype MigId = MigId { unMigId :: T.Text }-  deriving newtype (Eq, Ord, Show, IsString, Read, Df1.ToValue)---- | Hexadecimal representation of the SHA1 hash for this 'MigId'.-migId_sha1Hex :: MigId -> BL.ByteString-migId_sha1Hex-  = BB.toLazyByteString-  . BBP.primMapByteStringFixed BBP.word8HexFixed-  . SHA1.hash . T.encodeUtf8 . unMigId-------------------------------------------------------------------------------------- | The target to which to migrate.-data Target = Target Direction (Set MigId)-  deriving (Eq, Show)-------------------------------------------------------------------------------------- | A migrations execution plan.-data Plan = Plan Direction (Seq (MigId, UMig))-  -- ^ Unsafe constructor. The migrations are always listed in-  -- 'Forwards' order, even if intended to be run 'Backwards'.---- | Obtain a migrations execution 'Plan' if possible.-mkPlan-  :: Migs graph -- ^ Avaiable migrations.-  -> [MigId]-  -- ^ Migration history represented as the 'MigId's that have already been-  -- run, in the 'Forwards' order they have been run.-  -> Target -- ^ Migration target.-  -> Either Err_Plan Plan-mkPlan (Migs []) [] (Target d []) = Right (Plan d [])-mkPlan (Migs m0) ran (Target d req0) = do-    -- If 'req0' mentions an unknown, we abort.-    case Set.difference req0 (Map.keysSet m0) of-      [] -> pure ()-      req1 -> Left (Err_Plan_TargetsNotFound req1)-    -- Find all topological orders.-    let topos0 :: [[MigId]]-        topos0 = topos (fmap fst m0)-    -- Find the topological orders that share the 'ran' prefix.-    case catMaybes (List.stripPrefix ran <$> topos0) :: [[MigId]] of-      [] -> Left Err_Plan_HistoryUnknown-      topos1 -> do-        -- Find the topological order to use.-        topo :: [MigId] <- direction (bw topos0) (fw topos1) d-        -- Add 'UMig' data and return.-        Right (Plan d (Seq.fromList (map (id &&& getUMig) topo)))-  where-    getUMig :: MigId -> UMig-    getUMig = \mId -> snd (m0 Map.! mId)-    isGone :: MigId -> Bool-    isGone = \mId -> case getUMig mId of { UGone -> True; _ -> False }-    fw :: [[MigId]] -> Either Err_Plan [MigId]-    fw [] = error "fw: unreachable"-    fw topos0@(topo0:_) = case req0 of-      [] ->-        -- No specific migration was requested, so we run everything not gone.-        case filter (all (not . isGone)) topos0 of-          [] -> Left (Err_Plan_TargetsGone (Set.fromList (filter isGone topo0)))-          (topo:_) -> Right topo-      _ ->-        -- We exclude from 'req0' whatever has been run already.-        case Set.difference req0 (Set.fromList ran) of-          [] -> Right [] -- Nothing to do. All of 'req0' has been run already.-          req1 -> do-            -- Our final topological order will be a permutation of 'req1'.-            let perms :: [[MigId]] = List.permutations (Set.toList req1)-            -- We will only run as many migrations as 'req1' asks, so we-            -- discard the rest to keep things simple below.-            let topos1 :: [[MigId]] = List.take (Set.size req1) <$> topos0-            -- Select topological orders that matches one of 'perms', if any.-            case filter (\topo -> any (== topo) perms) topos1 of-              [] -> Left Err_Plan_TargetImpossible-              topos2@(topo2:_) -> do-                -- Select a topological order with migrations not gone.-                case List.find (all (not . isGone)) topos2 of-                  Just topo -> Right topo-                  Nothing -> Left (Err_Plan_TargetsGone-                    (Set.fromList (filter isGone topo2)))-    bw :: [[MigId]] -> Either Err_Plan [MigId]-    bw [] = error "bw: unreachable"-    bw topos0@(_:_) = case req0 of-      [] ->-        -- No specific migration was requested, so we undo everything not gone.-        case filter isGone ran of-          [] -> Right ran-          xs -> Left (Err_Plan_TargetsGone (Set.fromList xs))-      _ ->-        -- We exclude from 'req0' whatever hasn't been run already.-        case Set.intersection req0 (Set.fromList ran) of-          [] -> Right [] -- Nothing to do. None of 'req0' has run yet.-          req1 -> do-            -- Our final topological order will be a permutation of 'req1'.-            let perms :: [[MigId]] = List.permutations (Set.toList req1)-            -- We remove the prefix or ran non-removeable migrations.-            let topos1 :: [[MigId]]-                topos1 = List.drop (length ran - Set.size req1) <$> topos0-            -- We will only undo as many migrations as 'req1' asks, so we-            -- discard the rest to keep things simple below.-            let topos2 :: [[MigId]] = List.take (Set.size req1) <$> topos1-            -- Select a topological order that matches one of 'perms', if any.-            case filter (\topo -> any (== topo) perms) topos2 of-              [] -> Left Err_Plan_TargetImpossible-              topos3@(topo3:_) ->-                 -- Select a topological order with migrations not gone.-                 case List.find (all (not . isGone)) topos3 of-                  --  Just topo -> Right (List.reverse topo) -- In forwards order.-                   Just topo -> Right topo-                   Nothing -> Left (Err_Plan_TargetsGone-                     (Set.fromList (filter isGone topo3)))---- | Like 'mkPlan', but gets the history of ran migrations directly from the--- 'Registry'.-getPlan-  :: Di.Df1-  -> Migs graph -- ^ Avaiable migrations.-  -> Registry -- ^ Registry representing the current migration history.-  -> Target -- ^ Migration target.-  -> IO (Either Err_Plan Plan)-getPlan di0 migs_ reg tgt = do-  state <- registry_state reg di0-  let ran = map fst (state_committed state)-  pure (mkPlan migs_ ran tgt)-------------------------------------------------------------------------------------- | A 'State' can be described as a list of 'Log's ordered chronologically (see--- 'updateState').-data Log-  = Log_Prepare Time.UTCTime MigId Direction-  -- ^ A particular migration identified by 'MigId' is going to be executed in-  -- the specified 'Direction'.-  ---  -- This is the first commit in the two-phase commit approach to registering a-  -- migration as executed.-  ---  -- The time when this log entry was created is mentioned as well.-  | Log_Commit Time.UTCTime-  -- ^ The migration most recently prepared for execution with 'Log_Prepare' is-  -- being committed.-  ---  -- This is the second commit in the two-phase commit approach to registering a-  -- migration as executed.-  ---  -- The time when this log entry was created is mentioned as well.-  | Log_Abort Time.UTCTime-  -- ^ The migration most recently prepared for execution with 'Log_Prepare' is-  -- being aborted.-  ---  -- This undoes the first commit in the two-phase commit approach to-  -- registering a migration as executed.-  ---  -- The time when this log entry was created is mentioned as well.-  deriving (Eq, Show, Read)-------------------------------------------------------------------------------------- | Registry status.-data Status-  = Dirty MigId Direction-  -- ^ There is an uncommitted migration being run in the specified direction in-  -- the registry.-  | Clean-  -- ^ There are no uncommitted migrations in the registry.-  deriving (Eq, Show)-------------------------------------------------------------------------------------- | Internal 'State' of a 'Registry'.------ Create with 'emptyState' and 'updateState'.-data State = State Status [(MigId, Time.UTCTime)]-  deriving (Eq, Show)---- | Whether the registry is currently 'Dirty' or 'Clean'.-state_status :: State -> Status-state_status (State x _) = x---- | Committed migrations, chronologically ordered, with the most recently--- applied first last.-state_committed :: State -> [(MigId, Time.UTCTime)]-state_committed (State _ x) = List.reverse x---- | A clean 'State' without any committed migrations.-emptyState :: State-emptyState = State Clean []---- | Modify a 'State' by applying a 'Log' to it, if possible.------ Use 'emptyState' as the initial state.------ @--- 'Data.Foldable.foldlM' 'updateState' 'emptyState'---   :: 'Foldable' t---   => t 'Log'---   -> 'Either' 'Err_UpdateState' 'State'--- @-updateState :: State -> Log -> Either Err_UpdateState State-updateState (State Clean xs) (Log_Prepare _ mId Forwards)-  | elem mId (map fst xs) = Left (Err_UpdateState_Duplicate mId)-  | otherwise = Right (State (Dirty mId Forwards) xs)-updateState (State Clean xs) (Log_Prepare _ mId Backwards)-  | elem mId (map fst xs) = Right (State (Dirty mId Backwards) xs)-  | otherwise = Left (Err_UpdateState_NotFound mId)-updateState (State Clean _) _-  = Left Err_UpdateState_Clean-updateState (State (Dirty mId Forwards) xs) (Log_Commit t)-  = Right (State Clean ((mId, t) : xs))-updateState (State (Dirty _ Forwards) xs) (Log_Abort _)-  = Right (State Clean xs)-updateState (State (Dirty mId Backwards) xs) (Log_Commit _)-  = Right (State Clean (filter (\(mId', _) -> mId' /= mId) xs))-updateState (State (Dirty _ Backwards) xs) (Log_Abort _)-  = Right (State Clean xs)-updateState (State (Dirty _ _) _) _-  = Left Err_UpdateState_Dirty-------------------------------------------------------------------------------------- | 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 ()-cleanRegistry di0 migs_ reg0 = do-  let reg = mkRegistrish reg0-  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."-        case lookupMigs mId migs_ of-           Nothing -> do-              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."-              Ex.throwM (Err_CleanRegistry_MigGone mId)-           Just (_, UMig (st :: Store x) _ (Change ch)) -> do-              store_load st di1 mId $ \x -> do-                 Ex.uninterruptibleMask $ \restore -> do-                    restore (ch di1 (opposite d1) Recovery x)-                    registrish_abort reg di1 mId d1------------------------------------------------------------------------------------run :: Di.Df1 -> Registry -> Plan -> IO ()-run di0 reg0 (Plan d0 s0) = do-  let reg = mkRegistrish reg0-  fmap state_status (registrish_state reg di0) >>= \case-     Dirty mId d1 -> Ex.throwM (Err_Run_Dirty mId d1)-     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-           when (d0 == Forwards) $ do-              ba di1 (store_save st di1 mId)-           -- If 'ioDelete' is 'True' when we finish processing our migration,-           -- then we will delete the data for 'mId' from the 'Store'.-           ioDelete :: IORef Bool <- newIORef False-           -- We run 'store_load' even if we already know what the recovery data-           -- is, to ensure that it can be loaded later in case of catastrophe.-           Ex.finally-              (store_load st di1 mId $ \x -> do-                  registrish_prepare reg di1 mId d0-                  Ex.uninterruptibleMask $ \restore -> do-                     Ex.onException-                        (restore (ch di1 d0 Normal x))-                        (do ch di1 (opposite d0) Recovery x-                            registrish_abort reg di1 mId d0-                            when (d0 == Forwards)-                                 (writeIORef ioDelete True))-                     registrish_commit reg di1 mId d0-                     when (d0 == Backwards)-                          (writeIORef ioDelete True))-              (readIORef ioDelete >>= \case-                  True -> store_delete st di1 mId-                  False -> pure ())-------------------------------------------------------------------------------------- | Migrations registry, keeping track of what migrations have been run so far,--- as well as those that are running.------ Consider using 'Moto.Registry.newAppendOnlyRegistry' as an easy way to--- create a 'Registry'.-data Registry = Registry-  { registry_state :: Di.Df1 -> IO State-    -- ^ Current registry state.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but please don't log exceptions nor messages telling whether-    -- this function succeeds or fails, since this library already does that for-    -- you.-  , registry_prepare :: Di.Df1 -> MigId -> Direction-                     -> IO (Either Err_Prepare Log)-    -- ^ Register a new pending change in the registry.-    ---    -- Returns the 'Log_Prepare' that describes this change to the registry.-    ---    -- * This is the first commit in the two-phase commit mechanism to-    -- registering migrations as executed ('registry_commit' is the second).-    ---    -- * If 'Forwards', then the given 'MigId' shall be recorded in the-    -- registry as fully exceuted after a subsequent 'registry_commit'. If the-    -- given 'MigId' is already present and committed in the registry, then-    -- 'registry_prepare' shall return 'Err_Prepare_Duplicate'.-    ---    -- * If 'Backwards', then the given 'MigId', which must be already present-    -- and committed to the registry, will be removed from the list of currently-    -- committed migtrations after a subsequent 'registry_commit'.  If the-    -- 'MigId' is not already present and committed in the registry, then-    -- 'registry_prepare' shall return 'Err_Prepare_NotFound'.-    ---    -- * If there is already an uncommitted migration (that is, if the status is-    -- 'Dirty'), then 'Err_Prepare_Dirty' shall be returned. This constraint-    -- implies that it is impossible to have more than one pending change at a-    -- time.-    ---    -- * After a successful call to 'registry_prepare', the registry will be-    -- left in a 'Dirty' status until one of 'registry_commit' or-    -- 'registry_abort' is performed.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but don't log exceptions nor messages telling whether this-    -- function succeeds or fails, since this library already does that for you.-  , registry_abort :: Di.Df1 -> MigId -> Direction-                   -> IO (Either Err_Abort Log)-    -- ^ Abort the pending change in the given 'Direction' most recently-    -- introduced via 'registry_prepare', expected to be identified by the given-    -- 'MigId'.-    ---    -- Returns the 'Log_Abort' that describes this change to the registry.-    ---    -- If there is no pending change to be aborted (that is, if the status is-    -- 'Clean'), then 'Err_Abort_Clean' shall be returned.-    ---    -- If the currently pending migration's identifier is different from the-    -- the given 'MigId', or if its execution was intended for a 'Direction'-    -- different than the one specified here, then 'Err_Abort_Dirty' shall be-    -- returned.-    ---    -- After a successful call to 'registry_abort', the registry will be left-    -- in a 'Clean' status.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but don't log exceptions nor messages telling whether this-    -- function succeeds or fails, since this library already does that for you.-  , registry_commit :: Di.Df1 -> MigId -> Direction-                    -> IO (Either Err_Commit Log)-    -- ^ Commit the pending change in the given 'Direction' most recently-    -- introduced via 'registry_prepare', expected to be identified by the given-    -- 'MigId'.-    ---    -- Returns the 'Log_Commit' that describes this change to the registry.-    ---    -- This is the first commit in the two-phase commit mechanism to-    -- registering migrations as executed ('registry_prepare' is the first).-    ---    -- If there is no pending change to be committed (that is, if the status-    -- is 'Clean'), then 'Err_Commit_Clean' shall be returned.-    ---    -- If the currently pending migration's identifier is different from the-    -- the given 'MigId', or if its execution was intended for a 'Direction'-    -- different than the one specified here, then 'Err_Commit_Dirty' shall be-    -- returned.-    ---    -- After a successful call to 'registry_commit', the registry will be left-    -- in a 'Clean' status.-    ---    -- The passed in 'Di.Df1' can be used for logging if necessary (see "Di" and-    -- "Di.Df1"), but don't log exceptions nor messages telling whether this-    -- function succeeds or fails, since this library already does that for you.-  }---- | This is just like 'Registry', except the 'Left' return values are--- propagated as exceptions.-data Registrish = Registrish-  { registrish_state :: Di.Df1 -> IO State-  , registrish_prepare :: Di.Df1 -> MigId -> Direction -> IO ()-  , registrish_abort :: Di.Df1 -> MigId -> Direction -> IO ()-  , registrish_commit :: Di.Df1 -> MigId -> Direction -> IO ()-  }---- | Add some extra logging to a 'Registry', and promote the many 'Left'-mkRegistrish :: Registry -> Registrish-mkRegistrish reg =-  let f :: Ex.Exception a => Either a b -> IO ()-      f = either Ex.throwM (const (pure ()))-  in Registrish-       { registrish_state = registry_state reg-       , registrish_prepare = \di0 mId d -> do-           let di1 = Di.push "registry" di0-           Di.debug di1 "Adding pending registry change..."-           logException di1 (f =<< registry_prepare reg di1 mId d)-           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..."-           logException di1 (f =<< registry_abort reg di1 mId d)-           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..."-           logException di1 (f =<< registry_commit reg di1 mId d)-           Di.debug di1 "Committed change to registry."-       }------------------------------------------------------------------------------------- Various errors.---- | A 'Log' representation was malformed and couldn't be parsed.-data Err_MalformedLog = Err_MalformedLog String deriving (Eq, Show)-instance Ex.Exception Err_MalformedLog---- | Errors from 'mkPlan'.-data Err_Plan-  = Err_Plan_TargetsNotFound (Set MigId)-  -- ^ The targeted 'MigId's are not present in the migrations graph.-  | Err_Plan_HistoryUnknown-  -- ^ The specified migration history is not a known possibility according-  -- to the migrations dependency graph, meaning that it is not possible to-  -- add new migrations to it.-  | Err_Plan_TargetImpossible-  -- ^ It is not possible to obtain an execution plan given the requirements and-  -- dependency graph.-  | Err_Plan_TargetsGone (Set MigId)-  -- ^ Some migrations required to obtain an execution plan are 'Gone'.-  deriving (Eq, Show)-instance Ex.Exception Err_Plan---- | Errors from 'cleanRegistry'.------ By the time you receive these errors, they have already been logged.-data Err_CleanRegistry-  = Err_CleanRegistry_NotFoundInMigs MigId-  -- ^ The currently dirty 'MigId', as it appears in the 'Registry' records, is-  -- not present in the given 'Migs'.-  | Err_CleanRegistry_MigGone MigId-  -- ^ The code for the migration identfified 'MigId' is gone.-  deriving (Eq, Show)-instance Ex.Exception Err_CleanRegistry---- | Errors from 'run'.-data Err_Run-  = Err_Run_Dirty MigId Direction-  -- ^ The migration registry has an unexpected pending migration.-  deriving (Eq, Show)-instance Ex.Exception Err_Run---- | Errors from 'updateState'.-data Err_UpdateState-  = Err_UpdateState_Duplicate MigId-  | Err_UpdateState_NotFound MigId-  | Err_UpdateState_Clean-  | Err_UpdateState_Dirty-  deriving (Eq, Show)-instance Ex.Exception Err_UpdateState---- | Errors from 'registry_prepare'.-data Err_Prepare-  = Err_Prepare_Duplicate MigId-  | Err_Prepare_NotFound MigId-  | Err_Prepare_Dirty MigId Direction-  deriving (Eq, Show)-instance Ex.Exception Err_Prepare---- | Errors from 'registry_abort'.-data Err_Abort-  = Err_Abort_Clean-  | Err_Abort_Dirty MigId Direction-  deriving (Eq, Show)-instance Ex.Exception Err_Abort---- | Errors from 'registry_commit'.-data Err_Commit-  = Err_Commit_Clean-  | Err_Commit_Dirty MigId Direction-  deriving (Eq, Show)-instance Ex.Exception Err_Commit-------------------------------------------------------------------------------------- | Get all the topological orders for the given acyclic graph, in--- depth-first order.------ Each node is represented as @k@, and the graph is represented as an--- 'Map' from nodes to an 'Set' of nodes it depends on. For example, the graph--- @1 <- 2 <- 3@ where @1@ must come before @2@ and @2@ must come before @3@ can--- be represented as:------ @--- [(1,[]), (2,[1]), (3,[2])] :: 'Map' 'Int' ('Set' 'Int')--- @------ If there there are cycles in the graph, or if nodes depended upon are--- missing, then @('mempty' :: 'Set')@ is returned.------ If the given map is empty, then @('pure' [] :: 'Set')@ is returned.------ The length of each @[k]@ equals the size of the given 'Map' (i.e.,--- 'Map.size').-topos :: forall k. Ord k => Map k (Set k) -> [[k]]-topos [] = [[]]-topos m0 = go Set.empty m0-  where-    go :: Set k -> Map k (Set k) -> [[k]]-    go _  [] = [[]]-    go s0 m1 = do-      n <- Map.keys (Map.filter (\s1 -> s1 `Set.isSubsetOf` s0) m1)-      fmap (n:) (go (Set.insert n s0) (Map.delete n m1))---- TODO write more of these, especially for well formed graphs.--- prop_topos :: IntMap IntSet -> Bool--- prop_topos m = all (\y -> length y == IntMap.size m) (topos m)-------------------------------------------------------------------------------------- | Runs the given action, and if some exception happens, then log it to the--- 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!"-

@@ -1,411 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StrictData #-}--module Moto.Internal.Cli- ( RegistryConf(..)- , Opts- , getOpts- , run- ) where--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-import qualified System.IO as IO--import qualified Moto.Internal as I-------------------------------------------------------------------------------------- | Configuration for the 'I.Registry' that we'll use to keep track of the--- migrations we've run so far.-data RegistryConf = forall r. RegistryConf-  { registryConf_help :: String-    -- ^ Help message for the @--registry@ command line option.-  , registryConf_parse :: String -> Either String r-    -- ^ Parse the string obtained from the @--registry@ command line option,-    -- 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-    -- ^ Given the @r@ obtained from 'registryConf_parse', get a 'I.Registry'-    -- that can be used within the given scope.-  }-------------------------------------------------------------------------------------- | Run the command-line arguments parser, obtaining the 'Opts' necessary for--- calling 'run' afterwards.------ Notice that we can run the executable that calls 'getOpts' with a @--help@--- command line switch for extensive documentation on how to interact with--- @moto@.-getOpts-  :: RegistryConf-  -- ^ Configuration for the 'I.Registry' to use.-  ---  -- Among other things, this will dictate how we interpret the @--registry@-  -- 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.-  -> OA.Parser a-  -- ^ This extra parser can be used to read some extra configuration-  -- values from the command-line arguments, besides @moto@'s own.-  ---  -- For example, we can obtain things such as the name of a configuration-  -- file or a database connection string we might want to use in our-  -- migrations.-  ---  -- If no such extra data is required, then @'pure' ()@ can be used.-  ---  -- Notice that @moto@'s own command-line argument's parser has precedence-  -- over this parser. Yet, in the command-line, the argument's for the parser-  -- for @a@ should come before @moto@'s own subcommand arguments, otherwise the-  -- command line program will complain about a malformed command-line.-  -> IO (Opts, a)-getOpts rc p_a = OA.customExecParser-   (OA.prefs (OA.showHelpOnEmpty <> OA.noBacktrack))-   (let pi0 = oa_pi_Opts rc-    in pi0 { OA.infoParser = (,) <$> OA.infoParser pi0 <*> p_a })---- | Run @moto@ on the given migrations graph 'I.Migs', according to the--- instructions in 'Opts'.-run-  :: Di.Df1-  -- ^ Root logger. If you don't have a 'Di.Df1' for your program yet, you can-  -- obtain one using @Di.new@ from the-  -- [di](https://hackage.haskell.org/package/di) library.-  -> I.Migs graph-  -- ^ Avaliable migrations graph.-  -> Opts-  -- ^ Instructions on how to interact with our migrations.-  -- Obtain with 'getOpts'.-  -> IO ()-run di0 migs opts = do-  case opts_sub opts of-     Sub_Run x -> run_Run di0 migs x-     Sub_ShowMigrations x -> run_ShowMigrations migs x-     Sub_CheckMigrations x -> run_CheckMigrations di0 migs x-     Sub_ShowRegistry x -> run_ShowRegistry di0 x-     Sub_CleanRegistry x -> run_CleanRegistry di0 migs x-     Sub_DeleteRecoveryData x -> run_DeleteRecoveryData di0 migs x--run_Run :: Di.Df1 -> I.Migs graph -> Opts_Run -> IO ()-run_Run di0 migs x = do-  runWithRegistry (opts_run_withRegistry x) $ \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-           False -> I.run di0 reg p-           True -> BB.hPutBuilder IO.stdout (renderPlan p)--run_ShowMigrations :: I.Migs graph -> Opts_ShowMigrations -> IO ()-run_ShowMigrations migs x = do-  let gf = opts_showMigrations_graphFormat x-  BB.hPutBuilder IO.stdout (renderMigs gf migs)--run_CheckMigrations :: Di.Df1 -> I.Migs graph -> Opts_CheckMigrations -> IO ()-run_CheckMigrations di0 migs x = do-  runWithRegistry (opts_checkMigrations_withRegistry x) $ \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-      Right _ -> IO.exitSuccess--run_ShowRegistry :: Di.Df1 -> Opts_ShowRegistry -> IO ()-run_ShowRegistry di0 x = do-  runWithRegistry (opts_showRegistry_withRegistry x) $ \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-    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 ()--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-    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."-        IO.exitFailure-      Nothing -> do-        Di.error di1 "Migration not unknown."-        IO.exitFailure------------------------------------------------------------------------------------oa_pi_Opts :: RegistryConf -> OA.ParserInfo Opts-oa_pi_Opts rc = OA.info-  (oa_p_Opts rc OA.<**> OA.helper)-  (OA.fullDesc <> OA.progDesc "Command line interface to migrations.")--oa_p_Opts :: RegistryConf -> OA.Parser Opts-oa_p_Opts rc = Opts <$> oa_p_Sub rc---- | This is the input required by 'run', obtained from the command line--- arguments by using 'getOpts'.-data Opts = Opts-  { opts_sub :: Sub-    -- ^ Subcommand to run.-  }------------------------------------------------------------------------------------oa_p_Sub :: RegistryConf -> OA.Parser Sub-oa_p_Sub rc = OA.hsubparser $ mconcat-  [ OA.command "run"-      (fmap Sub_Run (oa_pi_Run rc))-  , OA.command "show-migrations"-      (fmap Sub_ShowMigrations oa_pi_ShowMigrations)-  , OA.command "check-migrations"-      (fmap Sub_CheckMigrations (oa_pi_CheckMigrations rc))-  , OA.command "show-registry"-      (fmap Sub_ShowRegistry (oa_pi_ShowRegistry rc))-  , OA.command "clean-registry"-      (fmap Sub_CleanRegistry (oa_pi_CleanRegistry rc))-  , OA.command "delete-recovery-data"-      (fmap Sub_DeleteRecoveryData oa_pi_DeleteRecoveryData)-  ]--data Sub-  = Sub_Run Opts_Run-  -- ^ Run migrations.-  | Sub_ShowMigrations Opts_ShowMigrations-  -- ^ Show available migrations.-  | Sub_CheckMigrations Opts_CheckMigrations-  -- ^ Check that the available migrations are compatible with the registry.-  | Sub_ShowRegistry Opts_ShowRegistry-  -- ^ Show migrations registry.-  | Sub_CleanRegistry Opts_CleanRegistry-  -- ^ I.Clean the registry if dirty.-  | Sub_DeleteRecoveryData Opts_DeleteRecoveryData-  -- ^ Delete content from the store.------------------------------------------------------------------------------------oa_pi_Run :: RegistryConf -> OA.ParserInfo Opts_Run-oa_pi_Run rc = OA.info (oa_p_Run rc) (OA.progDesc "Run migrations.")--oa_p_Run :: RegistryConf -> OA.Parser Opts_Run-oa_p_Run rc = Opts_Run-  <$> oa_p_WithRegistry rc-  <*> oa_p_Target-  <*> OA.flag True False-        (OA.long "no-dry-run" <>-         OA.help "Don't just show the execution plan, run it!")--data Opts_Run = Opts_Run-  { opts_run_withRegistry :: WithRegistry-  -- ^ Acquire a 'I.Registry' to use within a limited scope..-  , opts_run_target :: I.Target-  -- ^ Migration target.-  , opts_run_dryRun :: Bool-  -- ^ Don't run migrations, just show the execution plan.-  }------------------------------------------------------------------------------------oa_pi_ShowMigrations :: OA.ParserInfo Opts_ShowMigrations-oa_pi_ShowMigrations = OA.info oa_p_ShowMigrations-  (OA.progDesc "Show available migrations.")--oa_p_ShowMigrations :: OA.Parser Opts_ShowMigrations-oa_p_ShowMigrations = Opts_ShowMigrations <$> oa_p_GraphFormat--data Opts_ShowMigrations = Opts_ShowMigrations-  { opts_showMigrations_graphFormat :: GraphFormat-  -- ^ Format in which to render the migrations graph.-  }------------------------------------------------------------------------------------oa_pi_CheckMigrations :: RegistryConf -> OA.ParserInfo Opts_CheckMigrations-oa_pi_CheckMigrations rc = OA.info (oa_p_CheckMigrations rc)-  (OA.progDesc "Exit immediately with status 0 if the available \-               \migrations are compatible with the registry. \-               \Otherwise, exit with status 1.")--oa_p_CheckMigrations :: RegistryConf -> OA.Parser Opts_CheckMigrations-oa_p_CheckMigrations rc = Opts_CheckMigrations <$> oa_p_WithRegistry rc--data Opts_CheckMigrations = Opts_CheckMigrations-  { opts_checkMigrations_withRegistry :: WithRegistry-  -- ^ Acquire a 'I.Registry' to use within a limited scope..-  }------------------------------------------------------------------------------------oa_pi_ShowRegistry :: RegistryConf -> OA.ParserInfo Opts_ShowRegistry-oa_pi_ShowRegistry rc = OA.info-  (oa_p_ShowRegistry rc)-  (OA.progDesc "Show migrations registry.")--oa_p_ShowRegistry :: RegistryConf -> OA.Parser Opts_ShowRegistry-oa_p_ShowRegistry rc = Opts_ShowRegistry <$> oa_p_WithRegistry rc--data Opts_ShowRegistry = Opts_ShowRegistry-  { opts_showRegistry_withRegistry :: WithRegistry-  -- ^ Acquire a 'I.Registry' to use within a limited scope..-  }------------------------------------------------------------------------------------oa_pi_CleanRegistry :: RegistryConf -> OA.ParserInfo Opts_CleanRegistry-oa_pi_CleanRegistry rc = OA.info-  (oa_p_CleanRegistry rc)-  (OA.progDesc "Clean a dirty migrations registry.")--oa_p_CleanRegistry :: RegistryConf -> OA.Parser Opts_CleanRegistry-oa_p_CleanRegistry rc = Opts_CleanRegistry-  <$> oa_p_WithRegistry rc-  <*> OA.switch (OA.long "dry-run" <>-                 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.")--data Opts_CleanRegistry = Opts_CleanRegistry-  { opts_cleanRegistry_withRegistry :: WithRegistry-  -- ^ 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.-  }------------------------------------------------------------------------------------oa_pi_DeleteRecoveryData :: OA.ParserInfo Opts_DeleteRecoveryData-oa_pi_DeleteRecoveryData = OA.info oa_p_DeleteRecoveryData-  (OA.progDesc "Delete contents from the migrations data store.")--oa_p_DeleteRecoveryData :: OA.Parser Opts_DeleteRecoveryData-oa_p_DeleteRecoveryData = Opts_DeleteRecoveryData-  <$> fmap Set.fromList (OA.some (OA.option OA.str (OA.long "mig")))--data Opts_DeleteRecoveryData = Opts_DeleteRecoveryData-  { opts_store_migIds :: Set.Set I.MigId-  -- ^ 'I.MigId's for which to remove contents from the data store.-  }------------------------------------------------------------------------------------data WithRegistry = WithRegistry-  { runWithRegistry :: forall a. (I.Registry -> IO a) -> IO a }--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_p_Target :: OA.Parser I.Target-oa_p_Target = I.Target-  <$> OA.flag I.Forwards I.Backwards (OA.long "backwards")-  <*> fmap Set.fromList (OA.many (OA.option OA.str-        (OA.long "mig" <> OA.metavar "ID" <>-         OA.help "If specified, only consider running the migration identified \-                 \by this ID. Use multiple times for multiple migrations.")))------------------------------------------------------------------------------------oa_p_GraphFormat :: OA.Parser GraphFormat-oa_p_GraphFormat =-  OA.flag GraphFormatText GraphFormatDot-    (OA.long "dot" <> OA.help "Render graph in DOT (Graphviz) format.")--data GraphFormat-  = GraphFormatText -- ^ Render as plain text.-  | GraphFormatDot -- ^ Render as DOT (Graphviz).--renderMigs :: GraphFormat -> I.Migs graph -> BB.Builder-renderMigs = \case-  GraphFormatText -> renderMigs_Text-  GraphFormatDot -> renderMigs_Dot--renderMigs_Text :: I.Migs graph -> BB.Builder-renderMigs_Text (I.Migs m0) = mconcat $ do-   (here, deps) <- Map.toList (fmap (toList . fst) m0)-   case deps of-     [] -> [ f here <> " has no dependencies.\n" ]-     _  -> [ f here <> " depends on:\n" <>-             mconcat (map (\mId -> "  * " <> f mId <> "\n") deps) ]- where-   f :: I.MigId -> BB.Builder-   f (I.MigId x) = T.encodeUtf8Builder (T.pack (show x))--renderMigs_Dot :: I.Migs graph -> BB.Builder-renderMigs_Dot (I.Migs m0) = mconcat-   [ "digraph G {\n"-   , mconcat $ do-       (here, deps) <- Map.toList (fmap (toList . fst) m0)-       dep <- deps-       [ "  " <> f dep <> " -> " <> f here <> ";\n" ]-   , "}\n"-   ]- where-   f :: I.MigId -> BB.Builder-   f (I.MigId x) = T.encodeUtf8Builder (T.pack (show x))------------------------------------------------------------------------------------renderState :: I.State -> BB.Builder-renderState s =-  "Status: " <> fromString (show (I.state_status s)) <>-  "\nCommitted migrations: " <>-  fromString (show (length (I.state_committed s))) <> "\n" <>-  mconcat (map (\x -> "  " <> fromString (show x) <> "\n")-               (I.state_committed s))-------------------------------------------------------------------------------------- | Renders each 'MigId' in the 'Plan' preceded by its direction, and followed--- by a trailing newline.-renderPlan :: I.Plan -> BB.Builder-renderPlan (I.Plan _ []) = "Execution plan is empty. Nothing to do.\n"-renderPlan (I.Plan d s) = mconcat-    [ "Execution plan:\n"-    , mconcat (map (\(mId,_) -> "  Run " <> d' <> f mId <> "\n") (toList s))-    , "\nTo actually run the migrations, add --no-dry-run to "-    , "the command-line arguments.\n" ]-  where-    d' :: BB.Builder-    d' = I.direction "backwards " "forwards " d-    f :: I.MigId -> BB.Builder-    f (I.MigId x) = T.encodeUtf8Builder (T.pack (show x))-

@@ -1,276 +0,0 @@-{-# LANGUAGE CPP #-}--{- |--@moto@ is a library for describing and running /migrations/.--A /migration/ is any code that changes the environment somehow. The-stereotypical example of a migration is code that modifies the schema of a-database, but really anything that changes the environment somehow can be seen-as a migration. For example, moving a file to a different directory or host,-installing a package, deploying infrastructure, etc.--Essentially, a migration is a glorified bash script to which we hold dear because-of how devastating it can be for our project if we get it wrong. @moto@-understands this, so it is very careful about how, when, where and why it runs-these migrations, paying special attention to what happens when something goes-wrong. Of course, this being Haskell, we are encouraged to use domain specific-tools that can prevent us from accidentally writing the wrong migration code-(e.g., deleting a database rather than modifying it).--In @moto@ we can specify migrations in such a way that any data that is going-modified or deleted by a migration can be backed up for us in one or more-storages of our choice. If anything goes wrong, or if we latter decide to undo-these changes, then this backup will be automatically made available to us.--@moto@ is excellent for teams, where multiple collaborators can add new-migrations to the project at the same time, establishing dependencies between-them by saying “this migration needs to run before that other one” as a graph.-At compile time, @moto@ will ensure whether there is at least one way to execute-these migrations graph sequentially, or fail to compile otherwise. And at-runtime, it will execute this graph in any way that's compatible with the-environment where the migrations are being run. We don't need to worry about-serializing the release and deployment of migrations anymore, nor about making-sure that everybody runs migrations in the same order. We can delegate that-responsibility to @moto@.--Also, @moto@ is an excellent interface to interacting with our migrations and-environment. The final product we obtain as a user of @moto@ is a ready-made-/command line interface/ program that we can deploy and use to run all or some-migrations, undo them, render the dependency graph, compare it with the current-registry of migrations that have been run so far, obtain an execution plan as-well as very detailed logs in human and computer readable formats, etc.--@moto@ relies on a /registry/ of migrations to understand what has been run so-far and what hasn't. We can decide whether to keep this state locally or in-a remote database.--Last, but not least, @moto@ encourages us to remove old migrations after some-time, once these migrations are so old that maintaining them in the project is-an unnecessary burden to us. To this end, @moto@ offers us enough vocabulary to-mark said migrations as /gone/.--This module is inteded to be imported qualified:--@-import qualified "Moto"-@---}-module Moto- (- -- * Example- --- -- $example-- -- * Frequently Asked Questions- --- -- $faq-- -- * Running-   IC.run- , IC.Opts- , IC.getOpts-- -- * Describing individual migrations- , I.Mig(..)- , I.Store(..)- , I.mapStore- , I.Backup(..)- , I.Change(..)- , I.Direction(..)- , I.direction- , I.Mode(..)- , I.MigId(..)-- -- * Describing migrations graph- , I.Migs- , I.migs- , (I.*)- , I.DAG-- -- * Command line help- --- -- $cli_help- ) where--import qualified Moto.Internal as I-import qualified Moto.Internal.Cli as IC--{- $example--The main interface to running migrations is the command line. As a user of-@moto@, we are expected to create an executable that calls 'I.cli'. This-executable can then be deployed and used to run migrations.--Usually, the code in this executable will look like this:--@-\{\-\# LANGUAGE DataKinds \#\-\}-\{\-\# LANGUAGE PartialTypeSignatures \#\-\}----- Our project will be an executable, so we name our module Main as it is--- customary.-module Main (main) where----- "Moto" is designed to be imported qualified, as well as "Di", a module that--- provides the logging support required by "Moto".-import qualified "Di"-import qualified "Moto"---- Moreover, in this example we will use a migrations registry from the--- "Moto.File" module as an example.-import qualified "Moto.File"----- Here are some migrations, each of them with a identifier and a set of--- identifiers for other migrations expected to be executed before them when--- going 'Moto.Forwards'.------ Optional: It is actually recommended to put each migration in its own module.--- It is not necessary, but GHC takes a longer time and more resources to--- compile big modules. And considering the list of migrations in our project--- will always be growing, it's better to organize things that way from the--- start, as this can quickly become a source of slow compilation times.  For--- example, instead of Main.mig_black and Main.mig_blue, we can have--- MyProject.Migs.Black.mig and MyProject.Migs.Blue.mig that we import as--- necessary.-mig_red :: Moto.Mig "red" '["blue"]-mig_red = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.--mig_yellow :: Moto.Mig "yellow" '["black","red"]-mig_yellow = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.--mig_green :: Moto.Mig "green" '["red"]-mig_green = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.--mig_black :: Moto.Mig "black" '["blue"]-mig_black = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.--mig_blue :: Moto.Mig "blue" '[]-mig_blue = Moto.Mig ... -- Please see the documentation for 'Moto.Mig'.----- All of the 'Mig's that we might want to run need to be put in directed--- acyclic graph where each migration is a node and each edge is a dependency--- between migrations. In "Moto", we use 'Moto.migs' and the infix 'Moto.*'--- function to safely construct the graph of migrations.  The way we define our--- 'Moto.Migs' is a bit strange. Let's understand why.------ The Moto.* infix function says that the migrations that appear syntactically--- to its right can only mention as their dependencies migrations that appear--- to its syntactic left. This prevents us from mentioning our migrations in--- any order, but on the other hand it ensures at construction that there are no--- cycles nor dangling references in our dependency graph. If we get the order--- wrong, we will get a type-checker error. Moreover, migration identifiers are--- forced to be unique within this graph. The Moto.migs value itself is a dummy--- starting point we use as the leftmost argument to our chain of Moto.* calls.------ Observation: Note we avoid giving an explicit type to myMigs. Instead, we--- used the PartialTypeSignatures GHC extension to put an underscore there and--- allow GHC to use the inferred type. This is a desirable thing to do so as to--- prevent type-inference from accidentally inferring an undesired identifier--- for our migrations. This approach forces all of our Moto.Mig values to have--- their identifiers and dependencies fully specified at their definition site.--- We could have accomplished the same by not giving an type signature to our--- top level myMigs, or by simply inlining our definition of myMigs at its use--- site later on.-myMigs :: Moto.Migs _-myMigs = Moto.migs-  Moto.* mig_blue-  Moto.* mig_red-  Moto.* mig_black-  Moto.* mig_green-  Moto.* mig_yellow----- Finally, we have our main entry point. This program can be run from the--- command line and allows us to run and inspect migrations.-main :: IO ()-main = do--   -- Using 'Moto.getOpts' we parse the command-line arguments and obtain the-   -- instructions necessary to call 'Moto.run' afterwards.  We specify as-   -- arguments a 'Moto.Cli.RegistryConf' that describes the migrations-   -- registry where we keep track of the migrations that have run so far, as-   -- well as any extra command-line parsing needs we may have. In our case, we-   -- use a file in the filesystem as our registry, and we don't do any extra-   -- command-line argument parsing. Please see the documentation of-   -- 'Moto.getOpts' for more details.-   (myOpts, ()) <- Moto.getOpts Moto.File.registryConf (pure ())--   -- @moto@ uses "Di" for its own logging, so we first-   -- need to obtain a @'Di.Di' 'Df1.Level' 'Df1.Path' 'Df1.Message'@ value (also-   -- known by its 'Di.Df1' synonym). We can do this using 'Di.new'.-   Di.new $ \\di -> do--      -- Finally, we 'Moto.run' @moto@ as instructed by @myOpts@, passing in the-      -- 'Di.Df1' we just obtained, as well as the migrations graph-      Moto.run di myMigs myOpts-@--}--{- $faq--Here are some answers to questions you'll frequently ask yourselves when using-@moto@.--[Where should we maintain the migrations code for our project?]-Ideally, if you keep your whole project in a single code repository, you should-keep the migrations in that same repository, so that they are always in sync-with the code they cater for. You should create a standalone executable program-for running your migrations.--[Should my migrations program depend on the code I am migrating?]-Definitely not. That code will change or disappear over time, and it will affect-your migrations code whenever it changes. Your migrations code should stand-alone and have a holistic view of the history of the many environments where-your project runs, without depending on it.--[Can I use @moto@ to migrate projects not written in Haskell?]-Yes, @moto@ doesn't care about the language your project is written in. However,-the migrations code itself will have to be written Haskell.--[How do I deploy this?]-The same way you deploy other executables. We recommend packaging the program as-a Nix derivation containing a statically linked executable. Moreover, you can-package the migrations execution as a NixOS module that runs automatically-whenever a new version is deployed. Future versions of @moto@ will provide a web-interface for making migration execution a bit more interactive.--[How do I make sure my migrations work before deploying them?]-Generally speaking, as much as possible, you should use domain-specific-type-safe DSLs to describe your changes. But still, eventually, try the real-thing locally. Don't try to “mock” scenarios, that doesn't help. @moto@ makes-it quite easy to run migrations backwards afterwards. Moreover, in order to try-recovery scenarios, you try and throw exceptions from the different parts of-your migrations and see what happens.--[I don't see anything about SQL nor versioned data-types here]-Whether you are modifying an SQL database or moving any other kind of-bits around, @moto@ doesn't care about those details. You can write all the SQL-you want inside your migration, using the SQL-supporting library of your choice,-or version your datatypes as well.--[Is this ready for production?]-Migrations are a tricky business, and this is a very early release of @moto@, so-use at your own risk.--[Is the API stable?]-No, and it will never be. We will always break the API as necessary if it allows-us offer better safety and experience. However, we understand the subtle nature-of the projects relying on @moto@ an we will take the necessary steps to ensure-a positive and maintainable experience over time. Please see-the [changelog](https://hackage.haskell.org/package/moto/changelog) to-understand differences between versions and learn about any necessary changes-you'll need to make. In a @moto@ version @x.y.z@, we will always increase one of-@x@ or @y@ whenever a new version introduces backwards incompatible changes.--[I have more questions!]-We have more answers. Just [ask](https://gitlab.com/k0001/moto/issues).---}-#include "cli_help.docs"-

@@ -1,220 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | This module exports a 'I.Store' that stores 'I.Backup' data as files in the--- filesystem, as well as a 'I.Registry' backed by a file in the filesystem and--- related tools.------ Please import as:------ @--- import qualified "Moto.File"--- @-module Moto.File- ( -- * Registry-   registryConf- , withRegistry-- , -- * Store-   store- ) where--import Control.Applicative (empty)-import qualified Control.Exception.Safe as Ex-import qualified Control.Monad.Trans.State.Strict as S-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Trans (lift)-import qualified Data.Aeson as Ae-import qualified Data.Attoparsec.ByteString.Char8 as A8-import qualified Data.ByteString as B-import qualified Data.ByteString.Builder as BB-import qualified Data.Char as Char-import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL-import GHC.IO.Handle as IO (LockMode(ExclusiveLock), hLock)-import qualified Pipes as P-import qualified Pipes.Attoparsec as Pa-import qualified Pipes.ByteString as Pb-import qualified System.Directory as Dir-import System.FilePath ((</>))-import qualified System.IO as IO-import qualified System.IO.Error as IO--import qualified Moto.Internal as I-import qualified Moto.Internal.Cli as IC-import qualified Moto.Registry as R-------------------------------------------------------------------------------------- | Command-line configuration for a 'I.Registry' stored as a file in the--- 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_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-  }---- | 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-  -- ^ File where to store the registry logs.-  ---  -- An exclusive lock will be set on the this file (see 'IO.hLock'), which will-  -- stay open until this function returns. This is to prevent other programs to-  -- interact with this file while this program is running.-  -> (I.Registry -> m a)-  -> m a-withRegistry fp =-  withRegistryCustom renderLogLine parseLogLine fp---- | Obtain a 'I.Registry' backed by an append-only file storage as described by--- 'R.newAppendOnlyRegistry'.-withRegistryCustom-  :: (MonadIO m, Ex.MonadMask m)-  => (I.Log -> BB.Builder)-  -- ^ Render a single 'I.Log'. Be sure to add a trailing newline or similar if-  -- necessary, in order to separate one 'I.Log' entry from the next.-  -> 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.-  -> IO.FilePath-  -- ^ File where to store the registry logs.-  ---  -- An exclusive lock will be set on the this file (see 'IO.hLock'), which will-  -- stay open until this function returns. This is to prevent other programs to-  -- interact with this file while this program is running.-  -> (I.Registry -> m a)-  -> m a-withRegistryCustom render parser fp k = do-  Ex.bracket-    (liftIO $ do-       h <- IO.openBinaryFile fp IO.ReadWriteMode-       IO.hLock h IO.ExclusiveLock-       pure h)-    (liftIO . IO.hClose)-    (\h -> k =<< liftIO (do-       state0 <- do-          ea <- flip S.runStateT I.emptyState $ P.runEffect $ do-             P.for (Pa.parsed parser (Pb.fromHandle h)) $ \l -> do-                s0 <- lift S.get-                lift (either Ex.throwM S.put (I.updateState s0 l))-          case ea of-             (Left (e,_), _) -> Ex.throwM (I.Err_MalformedLog (show e))-             (Right _, x) -> pure x-       R.newAppendOnlyRegistry state0 $ \log' -> do-          BB.hPutBuilder h (render log')-          IO.hFlush h))-------------------------------------------------------------------------------------- Renders a 'I.Log' as a line of text with a trailing new line.------ Use 'parseLogLine' to undo this rendering.-renderLogLine :: I.Log -> BB.Builder-renderLogLine l = Ae.fromEncoding (Ae.toEncoding (LogV1 l)) <> "\n"---- Parses a 'I.Log' from a line of text rendered by 'renderLogLine'.------ Any leading or trailing newlines are consumed and skipped.-parseLogLine :: A8.Parser I.Log-parseLogLine = do-  _ <- A8.skipWhile (== '\n')-  s <- A8.takeWhile (/= '\n')-  _ <- A8.skipWhile (== '\n')-  case Ae.decodeStrict s of-     Just (LogV1 l) -> pure l-     Nothing -> fail "Malformed Log"---- | Wrapper around 'I.Log' used for serialization purposes, so that we don't--- expose a 'Ae.ToJSON' instance for 'I.Log'.-newtype LogV1 = LogV1 I.Log--instance Ae.ToJSON LogV1 where-  toJSON (LogV1 l) = case l of-    I.Log_Commit t -> Ae.toJSON $ Ae.object-      [ "action" Ae..= ("commit" :: T.Text)-      , "timestamp" Ae..= t ]-    I.Log_Abort t -> Ae.toJSON $ Ae.object-      [ "action" Ae..= ("abort" :: T.Text)-      , "timestamp" Ae..= t ]-    I.Log_Prepare t (I.MigId m) d -> Ae.toJSON $ Ae.object-      [ "action" Ae..= ("prepare" :: T.Text)-      , "timestamp" Ae..= t-      , "migration" Ae..= m-      , "direction" Ae..= (I.direction "backwards" "forwards" d :: T.Text) ]--instance Ae.FromJSON LogV1 where-  parseJSON = Ae.withObject "Log" $ \o -> do-    a :: T.Text <- o Ae..: "action"-    fmap LogV1 $ case a of-       "commit" -> I.Log_Commit-          <$> (o Ae..: "timestamp")-       "abort" -> I.Log_Abort-          <$> (o Ae..: "timestamp")-       "prepare" -> I.Log_Prepare-          <$> (o Ae..: "timestamp")-          <*> fmap I.MigId (o Ae..: "migration")-          <*> (o Ae..: "direction" >>= \case-                  "backwards" -> pure I.Backwards-                  "forwards" -> pure I.Forwards-                  (_ :: T.Text) -> empty)-       _ -> empty-------------------------------------------------------------------------------------- | A 'Store' that keeps data stored as files (one per 'MigId') in a filesystem--- directory.------ For maximum memory consumption efficiency, the data is written and read in a--- streaming fasion using a 'P.Producer'.-store-  :: FilePath -- ^ Path to a directory where the files are or will be stored.-  -> I.Store (P.Producer B.ByteString IO ())-store fp_dir = I.Store-    { I.store_save = \_ mId x -> do-        Dir.createDirectoryIfMissing True fp_dir-        Ex.bracket-          (IO.openBinaryFile (fp mId) IO.WriteMode)-          IO.hClose-          (\h -> do-             IO.hSetFileSize h 0-             IO.hSetBuffering h (IO.BlockBuffering Nothing)-             P.runEffect (x P.>-> Pb.toHandle h))-    , I.store_load = \_ mId k -> Ex.bracket-        (IO.openBinaryFile (fp mId) IO.ReadMode)-        IO.hClose-        (k . Pb.fromHandle)-    , I.store_delete = \_ mId -> Ex.catch-        (Dir.removeFile (fp mId))-        (\case e | IO.isDoesNotExistError e -> pure ()-                 | otherwise -> Ex.throwM e)-    }-  where-    fp :: I.MigId -> FilePath-    fp = \mId -> fp_dir </> TL.unpack (TL.decodeUtf8 (I.migId_sha1Hex mId)) <>-                            "_" <> escapeFileName (T.unpack (I.unMigId mId))-    escapeFileName :: String -> FilePath-    escapeFileName = map (\case c | Char.isAscii c && Char.isAlphaNum c -> c-                                  | otherwise -> '_')--{- TODO save this to a README file-    readme :: BB.Builder-    readme = "This directory contains backups made by Moto.File.store.\n\-             \\n\-             \  https://hackage.haskell.org/package/moto/docs/Moto-File.html#v:store\n\n\-             \\n\-             \To backup these backups, it is sufficient to copy the contents\n\-             \of this directory, preserving the file names."--}

@@ -1,115 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE LambdaCase #-}---- | This module exports tools for implementing a registry that @moto@ can use--- in order to keep track of the migrations that have been run so far.------ It's unlikely that you'll need to concern yourself with this module as an--- end user of @moto@.------ Please import as:------ @--- import qualified "Moto.Registry" as Moto--- @-module Moto.Registry- ( -- * Command-line support-   IC.RegistryConf(..)--   -- * Registry- , I.Registry(..)- , newAppendOnlyRegistry--   -- * State- , I.State- , I.emptyState- , I.updateState- , I.Log(..)--   -- * Errors- , Err_Tainted(..)- , I.Err_Prepare(..)- , I.Err_Abort(..)- , I.Err_Commit(..)- , I.Err_UpdateState(..)- ) where--import Control.Concurrent (readMVar, putMVar, takeMVar, newMVar)-import qualified Control.Exception.Safe as Ex-import qualified Data.Time as Time--import qualified Moto.Internal as I-import qualified Moto.Internal.Cli as IC-------------------------------------------------------------------------------------- | Create a 'I.Registry' backed by an append-only 'I.Log' storage.------ This registry maintains its internal 'I.State' in memory as long as it is--- possible to successfuly store all the changes in the underlying append-only--- storage. If at some point this fails unrecoverably, then 'Err_Tainted' will--- be thrown by the functions acting on this 'I.Registry'.------ It's important to acquire some kind of exclusive lock on the underlying--- storage, so that other applications can't poke it while our 'I.Registry' is--- running.-newAppendOnlyRegistry-  :: I.State-  -- ^ Initial registry state obtained by reading 'I.Log's from the backing-  -- append-only storage and running 'I.updateState' on them.-  -> (I.Log -> IO ())-  -- ^ How to store a newly generated 'I.Log' in the backing append-only-  -- storage.-  ---  -- If this function throws an exception, then the execption will propagated-  -- as usual, but also, this registry will be marked as tained and each-  -- subsequent operation on it will throw 'Err_Tainted'.-  -> IO I.Registry-newAppendOnlyRegistry !state0 putLog = do-  mvState <- newMVar (Just state0)-  let supdate :: (I.State -> Either e I.Log) -> IO (Either e I.Log)-      supdate f = Ex.bracketOnError-        (takeMVar mvState)-        (\_ -> putMVar mvState Nothing)-        (\case Nothing -> Ex.throwM Err_Tainted-               Just s0 -> case f s0 of-                 Left e -> pure (Left e)-                 Right log_ -> case I.updateState s0 log_ of-                   Left e -> Ex.throwM e -- This is unreachable code.-                   Right !s1 -> do-                     putLog log_-                     putMVar mvState (Just s1)-                     pure (Right log_))-  pure $ I.Registry-    { I.registry_state = \_ -> do-        maybe (Ex.throwM Err_Tainted) pure =<< readMVar mvState-    , I.registry_prepare = \_ mId d -> do-        t <- Time.getCurrentTime-        supdate $ \s -> case I.state_status s of-           I.Dirty mId' d' -> Left (I.Err_Prepare_Dirty mId' d')-           I.Clean -> case (d, elem mId (map fst (I.state_committed s))) of-             (I.Forwards, True) -> Left (I.Err_Prepare_Duplicate mId)-             (I.Backwards, False) -> Left (I.Err_Prepare_NotFound mId)-             _ -> Right (I.Log_Prepare t mId d)-    , I.registry_abort = \_ mId d -> do-        t <- Time.getCurrentTime-        supdate $ \s -> case I.state_status s of-           I.Clean -> Left I.Err_Abort_Clean-           I.Dirty mId' d'-             | mId /= mId' || d /= d' -> Left (I.Err_Abort_Dirty mId' d')-             | otherwise -> Right (I.Log_Abort t)-    , I.registry_commit = \_ mId d -> do-        t <- Time.getCurrentTime-        supdate $ \s -> case I.state_status s of-           I.Clean -> Left I.Err_Commit_Clean-           I.Dirty mId' d'-             | mId /= mId' || d /= d' -> Left (I.Err_Commit_Dirty mId' d')-             | otherwise -> Right (I.Log_Commit t)-    }---- | The 'I.Registry' is tainted, meaning our last attempt to interact with the--- registry's backing storage failed. We can't be certain about the current--- state of the 'I.Registry'.-data Err_Tainted = Err_Tainted deriving (Eq, Show)-instance Ex.Exception Err_Tainted-

@@ -1,114 +0,0 @@-{- $cli_help--This is the full description of the command line options supported by-'Moto.getOpts', using @Moto.File.fileRegistry@ as the registry.--Main program (here called @moto-example@):--@-Usage: moto-example COMMAND-  Command line interface to migrations.--Available options:-  -h,--help                Show this help text--Available commands:-  run                      Run migrations.-  show-migrations          Show available migrations.-  check-migrations         Exit immediately with status 0 if the available-                           migrations are compatible with the registry.-                           Otherwise, exit with status 1.-  show-registry            Show migrations registry.-  clean-registry           Clean a dirty migrations registry.-  delete-recovery-data     Delete contents from the migrations data store.-@----Subcommand @run@:--@-Usage: moto-example run --registry URI [--backwards] [--mig ID] [--no-dry-run]-  Run migrations.--Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/var\/db\/migrations-  --mig ID                 If specified, only consider running the migration-                           identified by this ID. Use multiple times for-                           multiple migrations.-  --no-dry-run             Don't just show the execution plan, run it!-  -h,--help                Show this help text-@----Subcommand @show-migrations@:--@-Usage: moto-example show-migrations [--dot]-  Show available migrations.--Available options:-  --dot                    Render graph in DOT (Graphviz) format.-  -h,--help                Show this help text-@----Subcommand @check-migrations@:--@-Usage: moto-example check-migrations --registry URI-  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-  -h,--help                Show this help text-@----Subcommand @show-registry@:--@-Usage: moto-example show-registry --registry URI-  Show migrations registry.--Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/var\/db\/migrations-  -h,--help                Show this help text-@----Subcommand @clean-registry@:--@-Usage: moto-example clean-registry --registry URI [--dry-run]-  Clean a dirty migrations registry.--Available options:-  --registry URI           File where registry file is stored. E.g.,-                           file:\/\/\/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.-  -h,--help                Show this help text-@----Subcommand @delete-recovery-data@:--@-Usage: moto-example delete-recovery-data --mig ARG-  Delete contents from the migrations data store.--Available options:-  -h,--help                Show this help text-@--}

@@ -1,9 +1,9 @@ name: moto-version: 0.0.2+version: 0.0.3 synopsis: General purpose migrations library license: Apache-2.0 license-file: LICENSE.txt-extra-source-files: README.md CHANGELOG.md lib/moto/cli_help.docs+extra-source-files: README.md CHANGELOG.md lib/cli_help.docs author: Renzo Carbonara maintainer: ren@ren!zone category: Database@@ -11,18 +11,20 @@ cabal-version: >=2.0  library-  hs-source-dirs: lib/moto+  hs-source-dirs: lib   default-language: Haskell2010   ghc-options: -Wall   exposed-modules:       Moto       Moto.Registry       Moto.File+      Moto.Internal+      Moto.Internal.Cli   build-depends:       aeson,       attoparsec,       base,-      moto-internal,+      base (>=4.6 && <5.0),       bytestring,       containers,       cryptohash-sha1,@@ -31,32 +33,12 @@       di-df1,       directory,       filepath,-      safe-exceptions,       mtl,       optparse-applicative,       pipes,       pipes-attoparsec,       pipes-bytestring,-      text,-      time,-      transformers--library moto-internal-  hs-source-dirs: lib/moto-internal-  default-language: Haskell2010-  ghc-options: -Wall-  exposed-modules:-      Moto.Internal-      Moto.Internal.Cli-  build-depends:-      base (>=4.6 && <5.0),-      bytestring,-      containers,-      cryptohash-sha1,-      df1,-      di-df1,       safe-exceptions,-      optparse-applicative,       text,       time,       transformers@@ -74,7 +56,6 @@     , di-core     , directory     , filepath-    , moto-internal     , moto     , random     , safe-exceptions