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

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

test_gitUpdateRev :: IO ()
test_gitUpdateRev :: Assertion
test_gitUpdateRev = do
  Attrs
interState <- Attrs -> Update () () -> IO Attrs
forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState (Update () () -> IO Attrs) -> Update () () -> IO Attrs
forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate (TestName -> Text -> Text -> IO Text
forall a. HasCallStack => TestName -> a
error TestName
"should be def") Text -> IO (Text, Text)
forall (f :: * -> *) a b p.
(Applicative f, IsString a, IsString b) =>
p -> f (a, b)
defaultBranchAndHEAD' -< ()
  let interState' :: Attrs
interState' = ((Freedom, Value) -> (Freedom, Value)) -> Attrs -> Attrs
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMS.map ((Freedom -> Freedom) -> (Freedom, Value) -> (Freedom, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\Freedom
_ -> Freedom
Free)) Attrs
interState
  Attrs
actualState <- Attrs -> Update () () -> IO Attrs
forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
interState' (Update () () -> IO Attrs) -> Update () () -> IO Attrs
forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate Text -> Text -> IO Text
forall (f :: * -> *) a p p.
(Applicative f, IsString a) =>
p -> p -> f a
latestRev' (TestName -> Text -> IO (Text, Text)
forall a. HasCallStack => TestName -> a
error TestName
"should update") -< ()
  Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (((Freedom, Value) -> Value
forall a b. (a, b) -> b
snd ((Freedom, Value) -> Value) -> Attrs -> HashMap Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Attrs
actualState) HashMap Text Value -> HashMap Text Value -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap Text Value
expectedState) (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$
    TestName -> Assertion
forall a. HasCallStack => TestName -> a
error (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$
      TestName
"State mismatch: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Attrs -> TestName
forall a. Show a => a -> TestName
show Attrs
actualState
  where
    latestRev' :: p -> p -> f a
latestRev' p
_ p
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-other-rev"
    defaultBranchAndHEAD' :: p -> f (a, b)
defaultBranchAndHEAD' p
_ = (a, b) -> f (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
"some-branch", b
"some-rev")
    initialState :: Attrs
initialState =
      [(Text, (Freedom, Value))] -> Attrs
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 =
      [(Text, Value)] -> HashMap Text Value
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 :: (b -> IO a) -> IO (b -> IO a)
once1 b -> IO a
f = do
  IORef Bool
used <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  (b -> IO a) -> IO (b -> IO a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> IO a) -> IO (b -> IO a)) -> (b -> IO a) -> IO (b -> IO a)
forall a b. (a -> b) -> a -> b
$ \b
x -> do
    Bool
used' <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
used
    if Bool
used'
      then TestName -> IO a
forall a. HasCallStack => TestName -> a
error TestName
"already used"
      else do
        IORef Bool -> Bool -> Assertion
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 :: (a -> b -> IO c) -> IO (a -> b -> IO c)
once2 a -> b -> IO c
f = do
  IORef Bool
used <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  (a -> b -> IO c) -> IO (a -> b -> IO c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a -> b -> IO c) -> IO (a -> b -> IO c))
-> (a -> b -> IO c) -> IO (a -> b -> IO c)
forall a b. (a -> b) -> a -> b
$ \a
x b
y -> do
    Bool
used' <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
used
    if Bool
used'
      then TestName -> IO c
forall a. HasCallStack => TestName -> a
error TestName
"already used"
      else do
        IORef Bool -> Bool -> Assertion
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'' <- (Text -> IO (Text, Text)) -> IO (Text -> IO (Text, Text))
forall b a. (b -> IO a) -> IO (b -> IO a)
once1 Text -> IO (Text, Text)
forall (f :: * -> *) a b p.
(Applicative f, IsString a, IsString b) =>
p -> f (a, b)
defaultBranchAndHEAD'
  Text -> Text -> IO Text
latestRev'' <- (Text -> Text -> IO Text) -> IO (Text -> Text -> IO Text)
forall a b c. (a -> b -> IO c) -> IO (a -> b -> IO c)
once2 Text -> Text -> IO Text
forall (f :: * -> *) a p p.
(Applicative f, IsString a) =>
p -> p -> f a
latestRev'
  Attrs
interState <- Attrs -> Update () () -> IO Attrs
forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState (Update () () -> IO Attrs) -> Update () () -> IO Attrs
forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate (TestName -> Text -> Text -> IO Text
forall a. HasCallStack => TestName -> a
error TestName
"should be def") Text -> IO (Text, Text)
defaultBranchAndHEAD'' -< ()
  let interState' :: Attrs
interState' = ((Freedom, Value) -> (Freedom, Value)) -> Attrs -> Attrs
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HMS.map ((Freedom -> Freedom) -> (Freedom, Value) -> (Freedom, Value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\Freedom
_ -> Freedom
Free)) Attrs
interState
  Attrs
actualState <- Attrs -> Update () () -> IO Attrs
forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
interState' (Update () () -> IO Attrs) -> Update () () -> IO Attrs
forall a b. (a -> b) -> a -> b
$ proc () ->
    (Text -> Text -> IO Text)
-> (Text -> IO (Text, Text)) -> Update () ()
gitUpdate Text -> Text -> IO Text
latestRev'' (TestName -> Text -> IO (Text, Text)
forall a. HasCallStack => TestName -> a
error TestName
"should update") -< ()
  Bool -> Assertion -> Assertion
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (((Freedom, Value) -> Value
forall a b. (a, b) -> b
snd ((Freedom, Value) -> Value) -> Attrs -> HashMap Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Attrs
actualState) HashMap Text Value -> HashMap Text Value -> Bool
forall a. Eq a => a -> a -> Bool
== HashMap Text Value
expectedState) (Assertion -> Assertion) -> Assertion -> Assertion
forall a b. (a -> b) -> a -> b
$
    TestName -> Assertion
forall a. HasCallStack => TestName -> a
error (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$
      TestName
"State mismatch: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Attrs -> TestName
forall a. Show a => a -> TestName
show Attrs
actualState
  where
    latestRev' :: p -> p -> f a
latestRev' p
_ p
_ = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-other-rev"
    defaultBranchAndHEAD' :: p -> f (a, b)
defaultBranchAndHEAD' p
_ = (a, b) -> f (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
"some-branch", b
"some-rev")
    initialState :: Attrs
initialState =
      [(Text, (Freedom, Value))] -> Attrs
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 =
      [(Text, Value)] -> HashMap Text Value
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")
        ]