{-# LANGUAGE Arrows #-}
{-# LANGUAGE OverloadedStrings #-}

module Niv.Git.Test
  ( tests,
  )
where

import Control.Monad
import qualified Data.Aeson.KeyMap as KM
import Data.Bifunctor
import qualified Data.HashMap.Strict as HMS
import Data.IORef
import Niv.Git.Cmd
import Niv.Sources
import Niv.Update
import qualified Test.Tasty as Tasty
import Test.Tasty.HUnit ((@=?))
import qualified Test.Tasty.HUnit as Tasty

tests :: [Tasty.TestTree]
tests :: [TestTree]
tests = [TestTree
test_repositoryParse, TestTree
test_gitUpdates]

test_repositoryParse :: Tasty.TestTree
test_repositoryParse :: TestTree
test_repositoryParse =
  [Char] -> [TestTree] -> TestTree
Tasty.testGroup
    [Char]
"repository parse"
    [ [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"goo" forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (PackageName, Object)
parseGitShortcut Text
"goo" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? forall a. Maybe a
Nothing,
      [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"git@github.com:nmattia/niv" forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (PackageName, Object)
parseGitShortcut Text
"git@github.com:nmattia/niv"
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? forall a. a -> Maybe a
Just
            (Text -> PackageName
PackageName Text
"niv", forall v. Key -> v -> KeyMap v
KM.singleton Key
"repo" Value
"git@github.com:nmattia/niv"),
      [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"ssh://git@github.com/stedolan/jq" forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (PackageName, Object)
parseGitShortcut Text
"ssh://git@github.com/stedolan/jq"
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? forall a. a -> Maybe a
Just
            (Text -> PackageName
PackageName Text
"jq", forall v. Key -> v -> KeyMap v
KM.singleton Key
"repo" Value
"ssh://git@github.com/stedolan/jq"),
      [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"https://github.com/stedolan/jq.git" forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (PackageName, Object)
parseGitShortcut Text
"https://github.com/stedolan/jq.git"
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? forall a. a -> Maybe a
Just
            (Text -> PackageName
PackageName Text
"jq", forall v. Key -> v -> KeyMap v
KM.singleton Key
"repo" Value
"https://github.com/stedolan/jq.git"),
      [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"https://github.com/stedolan/jq" forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (PackageName, Object)
parseGitShortcut Text
"https://github.com/stedolan/jq" forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? forall a. Maybe a
Nothing,
      [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"~/path/to/repo.git" forall a b. (a -> b) -> a -> b
$
        Text -> Maybe (PackageName, Object)
parseGitShortcut Text
"~/path/to/repo.git"
          forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? forall a. a -> Maybe a
Just
            (Text -> PackageName
PackageName Text
"repo", forall v. Key -> v -> KeyMap v
KM.singleton Key
"repo" Value
"~/path/to/repo.git")
    ]

test_gitUpdates :: Tasty.TestTree
test_gitUpdates :: TestTree
test_gitUpdates =
  [Char] -> [TestTree] -> TestTree
Tasty.testGroup
    [Char]
"updates"
    [ [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"rev is updated" Assertion
test_gitUpdateRev,
      [Char] -> Assertion -> TestTree
Tasty.testCase [Char]
"git is called once" Assertion
test_gitCalledOnce
    ]

test_gitUpdateRev :: IO ()
test_gitUpdateRev :: Assertion
test_gitUpdateRev = do
  Attrs
interState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate (forall a. HasCallStack => [Char] -> a
error [Char]
"should be def") forall {f :: * -> *} {a} {b} {p}.
(Applicative f, IsString a, IsString b) =>
p -> f (a, b)
defaultBranchAndHEAD' -< ()
  let interState' :: Attrs
interState' = forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMS.map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\Freedom
_ -> Freedom
Free)) Attrs
interState
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
interState' forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate forall {f :: * -> *} {a} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> f a
latestRev' (forall a. HasCallStack => [Char] -> a
error [Char]
"should update") -< ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Attrs
actualState) forall a. Eq a => a -> a -> Bool
== HashMap Text Value
expectedState) forall a b. (a -> b) -> a -> b
$
    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
      [Char]
"State mismatch: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Attrs
actualState
  where
    latestRev' :: p -> p -> f a
latestRev' p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-other-rev"
    defaultBranchAndHEAD' :: p -> f (a, b)
defaultBranchAndHEAD' p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
"some-branch", b
"some-rev")
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [(Text
"repo", (Freedom
Free, Value
"git@github.com:nmattia/niv"))]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"repo", Value
"git@github.com:nmattia/niv"),
          (Text
"branch", Value
"some-branch"),
          (Text
"rev", Value
"some-other-rev"),
          (Text
"type", Value
"git")
        ]

once1 :: (b -> IO a) -> IO (b -> IO a)
once1 :: forall b a. (b -> IO a) -> IO (b -> IO a)
once1 b -> IO a
f = do
  IORef Bool
used <- forall a. a -> IO (IORef a)
newIORef Bool
False
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \b
x -> do
    Bool
used' <- forall a. IORef a -> IO a
readIORef IORef Bool
used
    if Bool
used'
      then forall a. HasCallStack => [Char] -> a
error [Char]
"already used"
      else do
        forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
used Bool
True
        b -> IO a
f b
x

once2 :: (a -> b -> IO c) -> IO (a -> b -> IO c)
once2 :: forall a b c. (a -> b -> IO c) -> IO (a -> b -> IO c)
once2 a -> b -> IO c
f = do
  IORef Bool
used <- forall a. a -> IO (IORef a)
newIORef Bool
False
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \a
x b
y -> do
    Bool
used' <- forall a. IORef a -> IO a
readIORef IORef Bool
used
    if Bool
used'
      then forall a. HasCallStack => [Char] -> a
error [Char]
"already used"
      else do
        forall a. IORef a -> a -> Assertion
writeIORef IORef Bool
used Bool
True
        a -> b -> IO c
f a
x b
y

-- | This tests that we don't run the same git operations several times during
-- the update
test_gitCalledOnce :: IO ()
test_gitCalledOnce :: Assertion
test_gitCalledOnce = do
  Text -> IO (Text, Text)
defaultBranchAndHEAD'' <- forall b a. (b -> IO a) -> IO (b -> IO a)
once1 forall {f :: * -> *} {a} {b} {p}.
(Applicative f, IsString a, IsString b) =>
p -> f (a, b)
defaultBranchAndHEAD'
  Text -> Text -> IO Text
latestRev'' <- forall a b c. (a -> b -> IO c) -> IO (a -> b -> IO c)
once2 forall {f :: * -> *} {a} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> f a
latestRev'
  Attrs
interState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate (forall a. HasCallStack => [Char] -> a
error [Char]
"should be def") Text -> IO (Text, Text)
defaultBranchAndHEAD'' -< ()
  let interState' :: Attrs
interState' = forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMS.map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\Freedom
_ -> Freedom
Free)) Attrs
interState
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
interState' forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate Text -> Text -> IO Text
latestRev'' (forall a. HasCallStack => [Char] -> a
error [Char]
"should update") -< ()
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Attrs
actualState) forall a. Eq a => a -> a -> Bool
== HashMap Text Value
expectedState) forall a b. (a -> b) -> a -> b
$
    forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$
      [Char]
"State mismatch: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Attrs
actualState
  where
    latestRev' :: p -> p -> f a
latestRev' p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-other-rev"
    defaultBranchAndHEAD' :: p -> f (a, b)
defaultBranchAndHEAD' p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
"some-branch", b
"some-rev")
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [(Text
"repo", (Freedom
Free, Value
"git@github.com:nmattia/niv"))]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"repo", Value
"git@github.com:nmattia/niv"),
          (Text
"branch", Value
"some-branch"),
          (Text
"rev", Value
"some-other-rev"),
          (Text
"type", Value
"git")
        ]