    module Futhark.Pkg.SolveTests (tests) where

    import Data.Map qualified as M
    import Data.Monoid
    import Data.Text qualified as T
    import Futhark.Pkg.Solve
    import Futhark.Pkg.Types
    import Test.Tasty
    import Test.Tasty.HUnit
    import Prelude

    semverE :: T.Text -> SemVer
    semverE :: Text -> SemVer
    semverE Text
    s = case Text -> Either (ParseErrorBundle Text Void) SemVer
    parseVersion Text
    s of
      Left ParseErrorBundle Text Void
    err ->
        [Char] -> SemVer
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> SemVer) -> [Char] -> SemVer
    forall a b. (a -> b) -> a -> b
    $
          Text -> [Char]
    T.unpack Text
    s
            [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    " is not a valid version number: "
            [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> ParseErrorBundle Text Void -> [Char]
    forall s e.
    (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
    ParseErrorBundle s e -> [Char]
    errorBundlePretty ParseErrorBundle Text Void
    err
      Right SemVer
    x -> SemVer
    x

    -- | A world of packages and interdependencies for testing the solver
    -- without touching the outside world.
    testEnv :: PkgRevDepInfo
    testEnv :: PkgRevDepInfo
    testEnv =
      [((Text, SemVer), PkgRevDeps)] -> PkgRevDepInfo
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([((Text, SemVer), PkgRevDeps)] -> PkgRevDepInfo)
    -> [((Text, SemVer), PkgRevDeps)] -> PkgRevDepInfo
    forall a b. (a -> b) -> a -> b
    $
        ((Text, [(Text, [(Text, [(Text, Text)])])])
     -> [((Text, SemVer), PkgRevDeps)])
    -> [(Text, [(Text, [(Text, [(Text, Text)])])])]
    -> [((Text, SemVer), PkgRevDeps)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
          (Text, [(Text, [(Text, [(Text, Text)])])])
    -> [((Text, SemVer), PkgRevDeps)]
    forall {m :: * -> *} {a}.
    (Monad m, Semigroup a, IsString a) =>
    (a, m (a, m (Text, [(Text, Text)]))) -> m ((a, SemVer), PkgRevDeps)
    frob
          [ ( Text
    "athas",
              [ ( Text
    "foo",
                  [ (Text
    "0.1.0", []),
                    (Text
    "0.2.0", [(Text
    "athas/bar", Text
    "1.0.0")]),
                    (Text
    "0.3.0", [])
                  ]
                ),
                (Text
    "foo@v2", [(Text
    "2.0.0", [(Text
    "athas/quux", Text
    "0.1.0")])]),
                (Text
    "bar", [(Text
    "1.0.0", [])]),
                (Text
    "baz", [(Text
    "0.1.0", [(Text
    "athas/foo", Text
    "0.3.0")])]),
                ( Text
    "quux",
                  [ ( Text
    "0.1.0",
                      [ (Text
    "athas/foo", Text
    "0.2.0"),
                        (Text
    "athas/baz", Text
    "0.1.0")
                      ]
                    )
                  ]
                ),
                ( Text
    "quux_perm",
                  [ ( Text
    "0.1.0",
                      [ (Text
    "athas/baz", Text
    "0.1.0"),
                        (Text
    "athas/foo", Text
    "0.2.0")
                      ]
                    )
                  ]
                ),
                (Text
    "x_bar", [(Text
    "1.0.0", [(Text
    "athas/bar", Text
    "1.0.0")])]),
                (Text
    "x_foo", [(Text
    "1.0.0", [(Text
    "athas/foo", Text
    "0.3.0")])]),
                ( Text
    "tricky",
                  [ ( Text
    "1.0.0",
                      [ (Text
    "athas/foo", Text
    "0.2.0"),
                        (Text
    "athas/x_foo", Text
    "1.0.0")
                      ]
                    )
                  ]
                )
              ]
            ),
            -- Some mutually recursive packages.
            ( Text
    "nasty",
              [ (Text
    "foo", [(Text
    "1.0.0", [(Text
    "nasty/bar", Text
    "1.0.0")])]),
                (Text
    "bar", [(Text
    "1.0.0", [(Text
    "nasty/foo", Text
    "1.0.0")])])
              ]
            )
          ]
      where
        frob :: (a, m (a, m (Text, [(Text, Text)]))) -> m ((a, SemVer), PkgRevDeps)
    frob (a
    user, m (a, m (Text, [(Text, Text)]))
    repos) = do
          (a
    repo, m (Text, [(Text, Text)])
    repo_revs) <- m (a, m (Text, [(Text, Text)]))
    repos
          (Text
    rev, [(Text, Text)]
    deps) <- m (Text, [(Text, Text)])
    repo_revs
          let rev' :: SemVer
    rev' = Text -> SemVer
    semverE Text
    rev
              onDep :: (a, Text) -> (a, (SemVer, Maybe a))
    onDep (a
    dp, Text
    dv) = (a
    dp, (Text -> SemVer
    semverE Text
    dv, Maybe a
    forall a. Maybe a
    Nothing))
              deps' :: PkgRevDeps
    deps' = Map Text (SemVer, Maybe Text) -> PkgRevDeps
    PkgRevDeps (Map Text (SemVer, Maybe Text) -> PkgRevDeps)
    -> Map Text (SemVer, Maybe Text) -> PkgRevDeps
    forall a b. (a -> b) -> a -> b
    $ [(Text, (SemVer, Maybe Text))] -> Map Text (SemVer, Maybe Text)
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, (SemVer, Maybe Text))] -> Map Text (SemVer, Maybe Text))
    -> [(Text, (SemVer, Maybe Text))] -> Map Text (SemVer, Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ ((Text, Text) -> (Text, (SemVer, Maybe Text)))
    -> [(Text, Text)] -> [(Text, (SemVer, Maybe Text))]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> (Text, (SemVer, Maybe Text))
    forall {a} {a}. (a, Text) -> (a, (SemVer, Maybe a))
    onDep [(Text, Text)]
    deps
          ((a, SemVer), PkgRevDeps) -> m ((a, SemVer), PkgRevDeps)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((a
    user a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    "/" a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    repo, SemVer
    rev'), PkgRevDeps
    deps')

    newtype SolverRes = SolverRes BuildList
      deriving (SolverRes -> SolverRes -> Bool
    (SolverRes -> SolverRes -> Bool)
    -> (SolverRes -> SolverRes -> Bool) -> Eq SolverRes
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SolverRes -> SolverRes -> Bool
    == :: SolverRes -> SolverRes -> Bool
    $c/= :: SolverRes -> SolverRes -> Bool
    /= :: SolverRes -> SolverRes -> Bool
    Eq)

    instance Show SolverRes where
      show :: SolverRes -> [Char]
    show (SolverRes BuildList
    bl) = Text -> [Char]
    T.unpack (Text -> [Char]) -> Text -> [Char]
    forall a b. (a -> b) -> a -> b
    $ BuildList -> Text
    prettyBuildList BuildList
    bl

    solverTest :: PkgPath -> T.Text -> Either T.Text [(PkgPath, T.Text)] -> TestTree
    solverTest :: Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    p Text
    v Either Text [(Text, Text)]
    expected =
      [Char] -> Assertion -> TestTree
    testCase (Text -> [Char]
    T.unpack (Text -> [Char]) -> Text -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Text
    p Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "-" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> SemVer -> Text
    prettySemVer SemVer
    v') (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $
        (BuildList -> SolverRes)
    -> Either Text BuildList -> Either Text SolverRes
    forall a b. (a -> b) -> Either Text a -> Either Text b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BuildList -> SolverRes
    SolverRes (PkgRevDepInfo -> PkgRevDeps -> Either Text BuildList
    solveDepsPure PkgRevDepInfo
    testEnv PkgRevDeps
    target)
          Either Text SolverRes -> Either Text SolverRes -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= Either Text SolverRes
    expected'
      where
        target :: PkgRevDeps
    target = Map Text (SemVer, Maybe Text) -> PkgRevDeps
    PkgRevDeps (Map Text (SemVer, Maybe Text) -> PkgRevDeps)
    -> Map Text (SemVer, Maybe Text) -> PkgRevDeps
    forall a b. (a -> b) -> a -> b
    $ Text -> (SemVer, Maybe Text) -> Map Text (SemVer, Maybe Text)
    forall k a. k -> a -> Map k a
    M.singleton Text
    p (SemVer
    v', Maybe Text
    forall a. Maybe a
    Nothing)
        v' :: SemVer
    v' = Text -> SemVer
    semverE Text
    v
        expected' :: Either Text SolverRes
    expected' = BuildList -> SolverRes
    SolverRes (BuildList -> SolverRes)
    -> ([(Text, Text)] -> BuildList) -> [(Text, Text)] -> SolverRes
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Text SemVer -> BuildList
    BuildList (Map Text SemVer -> BuildList)
    -> ([(Text, Text)] -> Map Text SemVer)
    -> [(Text, Text)]
    -> BuildList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Text, SemVer)] -> Map Text SemVer
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(Text, SemVer)] -> Map Text SemVer)
    -> ([(Text, Text)] -> [(Text, SemVer)])
    -> [(Text, Text)]
    -> Map Text SemVer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Text, Text) -> (Text, SemVer))
    -> [(Text, Text)] -> [(Text, SemVer)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, Text) -> (Text, SemVer)
    forall {a}. (a, Text) -> (a, SemVer)
    onRes ([(Text, Text)] -> SolverRes)
    -> Either Text [(Text, Text)] -> Either Text SolverRes
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Either Text [(Text, Text)]
    expected
        onRes :: (a, Text) -> (a, SemVer)
    onRes (a
    dp, Text
    dv) = (a
    dp, Text -> SemVer
    semverE Text
    dv)

    tests :: TestTree
    tests :: TestTree
    tests =
      [Char] -> [TestTree] -> TestTree
    testGroup
        [Char]
    "SolveTests"
        [ Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/foo" Text
    "0.1.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right [(Text
    "athas/foo", Text
    "0.1.0")],
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/foo" Text
    "0.2.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right
              [ (Text
    "athas/foo", Text
    "0.2.0"),
                (Text
    "athas/bar", Text
    "1.0.0")
              ],
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/quux" Text
    "0.1.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right
              [ (Text
    "athas/quux", Text
    "0.1.0"),
                (Text
    "athas/foo", Text
    "0.3.0"),
                (Text
    "athas/baz", Text
    "0.1.0")
              ],
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/quux_perm" Text
    "0.1.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right
              [ (Text
    "athas/quux_perm", Text
    "0.1.0"),
                (Text
    "athas/foo", Text
    "0.3.0"),
                (Text
    "athas/baz", Text
    "0.1.0")
              ],
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/foo@v2" Text
    "2.0.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right
              [ (Text
    "athas/foo@v2", Text
    "2.0.0"),
                (Text
    "athas/quux", Text
    "0.1.0"),
                (Text
    "athas/foo", Text
    "0.3.0"),
                (Text
    "athas/baz", Text
    "0.1.0")
              ],
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/foo@v3" Text
    "3.0.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            Text -> Either Text [(Text, Text)]
    forall a b. a -> Either a b
    Left Text
    "Unknown package/version: athas/foo@v3-3.0.0",
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "nasty/foo" Text
    "1.0.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right
              [ (Text
    "nasty/foo", Text
    "1.0.0"),
                (Text
    "nasty/bar", Text
    "1.0.0")
              ],
          Text -> Text -> Either Text [(Text, Text)] -> TestTree
    solverTest Text
    "athas/tricky" Text
    "1.0.0" (Either Text [(Text, Text)] -> TestTree)
    -> Either Text [(Text, Text)] -> TestTree
    forall a b. (a -> b) -> a -> b
    $
            [(Text, Text)] -> Either Text [(Text, Text)]
    forall a b. b -> Either a b
    Right
              [ (Text
    "athas/tricky", Text
    "1.0.0"),
                (Text
    "athas/foo", Text
    "0.3.0"),
                (Text
    "athas/x_foo", Text
    "1.0.0")
              ]
        ]