experimental support for migration path solving

README.md

@@ -1,78 +0,0 @@
-## Database Setup
-
-After installing Postgres, run:
-
-```
-createuser start9-registry --pwprompt --superuser
-# Enter password start9-registry when prompted
-createdb start9-registry
-createdb start9-registry_test
-```
-
-## Haskell Setup
-
-1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
-	* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
-2. Install the `yesod` command line tool: `stack install yesod-bin --install-ghc`
-3. Build libraries: `stack build`
-
-If you have trouble, refer to the [Yesod Quickstart guide](https://www.yesodweb.com/page/quickstart) for additional detail.
-
-## Development
-
-Start a development server with:
-
-```
-stack exec -- yesod devel
-```
-
-As your code changes, your site will be automatically recompiled and redeployed to localhost.
-
-### Development tools
-
-`ghcid "-c=stack ghci --test"`
-
-- Clone [HIE](https://github.com/haskell/haskell-ide-engine)
-- Checkout latest reslease ie. `git checkout tags/1.3`
-- Follow github instructions to install for specific GHC version ie. `stack ./install.hs hie`
-- Install VSCode Haskell Language Server Extension
-
-To create `hie.yaml` if it does not exist:
-- gather executables by running `stack ide targets`
-- see [here](https://github.com/haskell/haskell-ide-engine#project-configuration) for file setup details
-
-## Tests
-
-```
-stack test --flag start9-registry:library-only --flag start9-registry:dev
-```
-
-(Because `yesod devel` passes the `library-only` and `dev` flags, matching those flags means you don't need to recompile between tests and development, and it disables optimization to speed up your test compile times).
-
-## Builds
-
-`make`
-
-### Tests with HIE Setup
-- install hspec-discover globally `cabal install hspec-discover` (requires cabal installation)
-- Current [issue](https://github.com/haskell/haskell-ide-engine/issues/1564) open for error pertaining to obtaining flags for test files
-	- recommended to setup hie.yaml
-	- recommended to run `stack build --test --no-run-tests` *before* any test files are open and that test files compile without error 
-	- helps to debug a specific file: `hie --debug test/Main.hs`
-
-## Documentation
-
-* Read the [Yesod Book](https://www.yesodweb.com/book) online for free
-* Check [Stackage](http://stackage.org/) for documentation on the packages in your LTS Haskell version, or [search it using Hoogle](https://www.stackage.org/lts/hoogle?q=). Tip: Your LTS version is in your `stack.yaml` file.
-* For local documentation, use:
-	* `stack haddock --open` to generate Haddock documentation for your dependencies, and open that documentation in a browser
-	* `stack hoogle <function, module or type signature>` to generate a Hoogle database and search for your query
-* The [Yesod cookbook](https://github.com/yesodweb/yesod-cookbook) has sample code for various needs
-
-## Getting Help
-
-* Ask questions on [Stack Overflow, using the Yesod or Haskell tags](https://stackoverflow.com/questions/tagged/yesod+haskell)
-* Ask the [Yesod Google Group](https://groups.google.com/forum/#!forum/yesodweb)
-* There are several chatrooms you can ask for help:
-	* For IRC, try Freenode#yesod and Freenode#haskell
-	* [Functional Programming Slack](https://fpchat-invite.herokuapp.com/), in the #haskell, #haskell-beginners, or #yesod channels.

src/Lib/Types/Emver/Migration.hs

@@ -0,0 +1,85 @@
+module Lib.Types.Emver.Migration (from, to, dead, navigate) where
+
+import Control.Arrow (Arrow ((&&&), (***)))
+import Data.Bool (Bool (..), not, otherwise, (&&))
+import Data.Monoid ((<>))
+import Lib.Types.Emver (
+    Version,
+    VersionRange (None),
+    conj,
+    exactly,
+    (<||),
+ )
+import Protolude (($))
+import Startlude (
+    Alternative ((<|>)),
+    Eq (..),
+    Maybe (..),
+    Num (..),
+    Show,
+    Traversable (traverse),
+    Word,
+    filter,
+    flip,
+    headMay,
+    mapMaybe,
+    pure,
+    uncurry,
+    (.),
+ )
+
+
+type MigrationGoal = (Version, Version)
+data MigrationTactic = MigrationTactic
+    { migrationTacticSourceRange :: VersionRange
+    , migrationTacticTargetRange :: VersionRange
+    , migrationTacticMidpoints :: [VersionRange]
+    }
+    deriving (Show)
+
+
+from :: Version -> VersionRange -> MigrationTactic
+from v range = MigrationTactic range (exactly v) []
+
+
+to :: Version -> VersionRange -> MigrationTactic
+to v range = MigrationTactic (exactly v) range []
+
+
+(>>>) :: MigrationTactic -> MigrationTactic -> MigrationTactic
+(MigrationTactic s t ms) >>> (MigrationTactic s' t' ms') = case conj t s' of
+    None -> MigrationTactic None None []
+    other -> MigrationTactic s t' (ms <> (other : ms'))
+
+
+dead :: MigrationTactic -> Bool
+dead (MigrationTactic None _ _) = True
+dead (MigrationTactic _ None _) = True
+dead _ = False
+
+
+navigate :: [MigrationTactic] -> MigrationGoal -> [Version] -> Maybe [Version]
+navigate = navigate' 1
+
+
+navigate' :: Word -> [MigrationTactic] -> MigrationGoal -> [Version] -> Maybe [Version]
+navigate' n tactics (source, target) avail =
+    case headMay $ mapMaybe (traverse (flip select avail) . migrationTacticMidpoints) (filter (satisfactory . bounds) tactics) of
+        Nothing -> if n == 0 then Nothing else navigate' (n - 1) composites (source, target) avail
+        Just x -> Just x
+    where
+        bounds = migrationTacticSourceRange &&& migrationTacticTargetRange
+        satisfactory = uncurry (&&) . ((source <||) *** (target <||))
+        composites = do
+            x <- tactics
+            y <- tactics
+            pure x <|> pure y <|> case (x >>> y, y >>> x) of
+                (m@(MigrationTactic s t ms), m'@(MigrationTactic s' t' ms'))
+                    | not (dead m) && not (dead m') -> [m, m']
+                    | not (dead m) -> pure m
+                    | not (dead m') -> pure m'
+                    | otherwise -> []
+
+
+select :: VersionRange -> [Version] -> Maybe Version
+select range avail = headMay $ filter (<|| range) avail