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

module Niv.GitHub.Test where

import Control.Monad
import Data.Bifunctor
import qualified Data.HashMap.Strict as HMS
import Data.IORef
import Niv.GitHub
import Niv.GitHub.API
import Niv.Update

test_githubInitsProperly :: IO ()
test_githubInitsProperly :: IO ()
test_githubInitsProperly = do
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate forall {f :: * -> *} {a} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> f a
prefetch forall {f :: * -> *} {a} {p} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> p -> f a
latestRev forall {f :: * -> *} {p} {p}.
Applicative f =>
p -> p -> f GithubRepo
ghRepo -< ()
  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
    prefetch :: p -> p -> f a
prefetch p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-sha"
    latestRev :: p -> p -> p -> f a
latestRev p
_ p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-rev"
    ghRepo :: p -> p -> f GithubRepo
ghRepo p
_ p
_ =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        GithubRepo
          { repoDescription :: Maybe Text
repoDescription = forall a. a -> Maybe a
Just Text
"some-descr",
            repoHomepage :: Maybe Text
repoHomepage = forall a. a -> Maybe a
Just Text
"some-homepage",
            repoDefaultBranch :: Maybe Text
repoDefaultBranch = forall a. a -> Maybe a
Just Text
"master"
          }
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", (Freedom
Free, Value
"nmattia")),
          (Text
"repo", (Freedom
Free, Value
"niv"))
        ]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", Value
"nmattia"),
          (Text
"repo", Value
"niv"),
          (Text
"homepage", Value
"some-homepage"),
          (Text
"description", Value
"some-descr"),
          (Text
"branch", Value
"master"),
          (Text
"url", Value
"https://github.com/nmattia/niv/archive/some-rev.tar.gz"),
          (Text
"rev", Value
"some-rev"),
          (Text
"sha256", Value
"some-sha"),
          (Text
"type", Value
"tarball"),
          (Text
"url_template", Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
        ]

test_githubUpdates :: IO ()
test_githubUpdates :: IO ()
test_githubUpdates = do
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate forall {f :: * -> *} {a} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> f a
prefetch forall {f :: * -> *} {a} {p} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> p -> f a
latestRev forall {f :: * -> *} {p} {p}.
Applicative f =>
p -> p -> f GithubRepo
ghRepo -< ()
  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
    prefetch :: p -> p -> f a
prefetch p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"new-sha"
    latestRev :: p -> p -> p -> f a
latestRev p
_ p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"new-rev"
    ghRepo :: p -> p -> f GithubRepo
ghRepo p
_ p
_ =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        GithubRepo
          { repoDescription :: Maybe Text
repoDescription = forall a. a -> Maybe a
Just Text
"some-descr",
            repoHomepage :: Maybe Text
repoHomepage = forall a. a -> Maybe a
Just Text
"some-homepage",
            repoDefaultBranch :: Maybe Text
repoDefaultBranch = forall a. a -> Maybe a
Just Text
"master"
          }
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", (Freedom
Free, Value
"nmattia")),
          (Text
"repo", (Freedom
Free, Value
"niv")),
          (Text
"homepage", (Freedom
Free, Value
"some-homepage")),
          (Text
"description", (Freedom
Free, Value
"some-descr")),
          (Text
"branch", (Freedom
Free, Value
"master")),
          (Text
"url", (Freedom
Free, Value
"https://github.com/nmattia/niv/archive/some-rev.tar.gz")),
          (Text
"rev", (Freedom
Free, Value
"some-rev")),
          (Text
"sha256", (Freedom
Free, Value
"some-sha")),
          (Text
"type", (Freedom
Free, Value
"tarball")),
          (Text
"url_template", (Freedom
Free, Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"))
        ]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", Value
"nmattia"),
          (Text
"repo", Value
"niv"),
          (Text
"homepage", Value
"some-homepage"),
          (Text
"description", Value
"some-descr"),
          (Text
"branch", Value
"master"),
          (Text
"url", Value
"https://github.com/nmattia/niv/archive/new-rev.tar.gz"),
          (Text
"rev", Value
"new-rev"),
          (Text
"sha256", Value
"new-sha"),
          (Text
"type", Value
"tarball"),
          (Text
"url_template", Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
        ]

test_githubDoesntOverrideRev :: IO ()
test_githubDoesntOverrideRev :: IO ()
test_githubDoesntOverrideRev = do
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate forall {f :: * -> *} {a} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> f a
prefetch forall {p} {p} {p} {a}. p -> p -> p -> a
latestRev forall {p} {p} {a}. p -> p -> a
ghRepo -< ()
  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
    prefetch :: p -> p -> f a
prefetch p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"new-sha"
    latestRev :: p -> p -> p -> a
latestRev p
_ p
_ p
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"shouldn't fetch rev"
    ghRepo :: p -> p -> a
ghRepo p
_ p
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"shouldn't fetch repo"
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", (Freedom
Free, Value
"nmattia")),
          (Text
"repo", (Freedom
Free, Value
"niv")),
          (Text
"homepage", (Freedom
Free, Value
"some-homepage")),
          (Text
"description", (Freedom
Free, Value
"some-descr")),
          (Text
"branch", (Freedom
Free, Value
"master")),
          (Text
"url", (Freedom
Free, Value
"https://github.com/nmattia/niv/archive/some-rev.tar.gz")),
          (Text
"rev", (Freedom
Locked, Value
"custom-rev")),
          (Text
"sha256", (Freedom
Free, Value
"some-sha")),
          (Text
"type", (Freedom
Free, Value
"tarball")),
          (Text
"url_template", (Freedom
Free, Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"))
        ]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", Value
"nmattia"),
          (Text
"repo", Value
"niv"),
          (Text
"homepage", Value
"some-homepage"),
          (Text
"description", Value
"some-descr"),
          (Text
"branch", Value
"master"),
          (Text
"url", Value
"https://github.com/nmattia/niv/archive/custom-rev.tar.gz"),
          (Text
"rev", Value
"custom-rev"),
          (Text
"sha256", Value
"new-sha"),
          (Text
"type", Value
"tarball"),
          (Text
"url_template", Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
        ]

-- TODO: HMS diff for test output
test_githubURLFallback :: IO ()
test_githubURLFallback :: IO ()
test_githubURLFallback = do
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate forall {f :: * -> *} {a} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> f a
prefetch forall {p} {p} {p} {a}. p -> p -> p -> a
latestRev forall {p} {p} {a}. p -> p -> a
ghRepo -< ()
  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
    prefetch :: p -> p -> f a
prefetch p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"some-sha"
    latestRev :: p -> p -> p -> a
latestRev p
_ p
_ p
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"shouldn't fetch rev"
    ghRepo :: p -> p -> a
ghRepo p
_ p
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"shouldn't fetch repo"
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"url_template", (Freedom
Free, Value
"https://foo.com/<baz>.tar.gz")),
          (Text
"baz", (Freedom
Free, Value
"tarball"))
        ]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"url_template", Value
"https://foo.com/<baz>.tar.gz"),
          (Text
"baz", Value
"tarball"),
          (Text
"url", Value
"https://foo.com/tarball.tar.gz"),
          (Text
"sha256", Value
"some-sha"),
          (Text
"type", Value
"tarball")
        ]

test_githubUpdatesOnce :: IO ()
test_githubUpdatesOnce :: IO ()
test_githubUpdatesOnce = do
  IORef Bool
ioref <- forall a. a -> IO (IORef a)
newIORef Bool
False
  Attrs
tmpState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
initialState forall a b. (a -> b) -> a -> b
$ proc () ->
    (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate (forall {b} {p} {p}. IsString b => IORef Bool -> p -> p -> IO b
prefetch IORef Bool
ioref) forall {f :: * -> *} {a} {p} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> p -> f a
latestRev forall {f :: * -> *} {p} {p}.
Applicative f =>
p -> p -> f GithubRepo
ghRepo -< ()
  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
tmpState) 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
tmpState
  -- Set everything free
  let tmpState' :: Attrs
tmpState' = 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
tmpState
  Attrs
actualState <- forall a. Attrs -> Update () a -> IO Attrs
evalUpdate Attrs
tmpState' forall a b. (a -> b) -> a -> b
$ proc () ->
    (Bool -> Text -> IO Text)
-> (Text -> Text -> Text -> IO Text)
-> (Text -> Text -> IO GithubRepo)
-> Update () ()
githubUpdate (forall {b} {p} {p}. IsString b => IORef Bool -> p -> p -> IO b
prefetch IORef Bool
ioref) forall {f :: * -> *} {a} {p} {p} {p}.
(Applicative f, IsString a) =>
p -> p -> p -> f a
latestRev forall {f :: * -> *} {p} {p}.
Applicative f =>
p -> p -> f GithubRepo
ghRepo -< ()
  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
    prefetch :: IORef Bool -> p -> p -> IO b
prefetch IORef Bool
ioref p
_ p
_ = do
      forall a. IORef a -> IO a
readIORef IORef Bool
ioref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Bool
False -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Bool
True -> forall a. HasCallStack => [Char] -> a
error [Char]
"Prefetch should be called once!"
      forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ioref Bool
True
      forall (f :: * -> *) a. Applicative f => a -> f a
pure b
"new-sha"
    latestRev :: p -> p -> p -> f a
latestRev p
_ p
_ p
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
"new-rev"
    ghRepo :: p -> p -> f GithubRepo
ghRepo p
_ p
_ =
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
        GithubRepo
          { repoDescription :: Maybe Text
repoDescription = forall a. a -> Maybe a
Just Text
"some-descr",
            repoHomepage :: Maybe Text
repoHomepage = forall a. a -> Maybe a
Just Text
"some-homepage",
            repoDefaultBranch :: Maybe Text
repoDefaultBranch = forall a. a -> Maybe a
Just Text
"master"
          }
    initialState :: Attrs
initialState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", (Freedom
Free, Value
"nmattia")),
          (Text
"repo", (Freedom
Free, Value
"niv")),
          (Text
"homepage", (Freedom
Free, Value
"some-homepage")),
          (Text
"description", (Freedom
Free, Value
"some-descr")),
          (Text
"branch", (Freedom
Free, Value
"master")),
          (Text
"url", (Freedom
Free, Value
"https://github.com/nmattia/niv/archive/some-rev.tar.gz")),
          (Text
"rev", (Freedom
Free, Value
"some-rev")),
          (Text
"sha256", (Freedom
Free, Value
"some-sha")),
          (Text
"type", (Freedom
Free, Value
"tarball")),
          (Text
"url_template", (Freedom
Free, Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"))
        ]
    expectedState :: HashMap Text Value
expectedState =
      forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
        [ (Text
"owner", Value
"nmattia"),
          (Text
"repo", Value
"niv"),
          (Text
"homepage", Value
"some-homepage"),
          (Text
"description", Value
"some-descr"),
          (Text
"branch", Value
"master"),
          (Text
"url", Value
"https://github.com/nmattia/niv/archive/new-rev.tar.gz"),
          (Text
"rev", Value
"new-rev"),
          (Text
"sha256", Value
"new-sha"),
          (Text
"type", Value
"tarball"),
          (Text
"url_template", Value
"https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
        ]