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

module Niv.GitHub.Test where

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

test_githubInitsProperly :: IO ()
test_githubInitsProperly = do
    actualState <- evalUpdate initialState $ proc () ->
      githubUpdate prefetch latestRev ghRepo -< ()
    unless ((snd <$> actualState) == expectedState) $
      error $ "State mismatch: " <> show actualState
  where
    prefetch _ _ = pure "some-sha"
    latestRev _ _ _ = pure "some-rev"
    ghRepo _ _ = pure GithubRepo
      { repoDescription = Just "some-descr"
      , repoHomepage = Just "some-homepage"
      , repoDefaultBranch = Just "master"
      }
    initialState = HMS.fromList
      [ ("owner", (Free, "nmattia"))
      , ("repo", (Free, "niv")) ]
    expectedState = HMS.fromList
      [ ("owner", "nmattia")
      , ("repo", "niv")
      , ("homepage", "some-homepage")
      , ("description", "some-descr")
      , ("branch", "master")
      , ("url", "https://github.com/nmattia/niv/archive/some-rev.tar.gz")
      , ("rev", "some-rev")
      , ("sha256", "some-sha")
      , ("type", "tarball")
      , ("url_template", "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
      ]

test_githubUpdates :: IO ()
test_githubUpdates = do
    actualState <- evalUpdate initialState $ proc () ->
      githubUpdate prefetch latestRev ghRepo -< ()
    unless ((snd <$> actualState) == expectedState) $
      error $ "State mismatch: " <> show actualState
  where
    prefetch _ _ = pure "new-sha"
    latestRev _ _ _ = pure "new-rev"
    ghRepo _ _ = pure GithubRepo
      { repoDescription = Just "some-descr"
      , repoHomepage = Just "some-homepage"
      , repoDefaultBranch = Just "master"
      }
    initialState = HMS.fromList
      [ ("owner", (Free, "nmattia"))
      , ("repo", (Free, "niv"))
      , ("homepage", (Free, "some-homepage"))
      , ("description", (Free, "some-descr"))
      , ("branch", (Free, "master"))
      , ("url", (Free, "https://github.com/nmattia/niv/archive/some-rev.tar.gz"))
      , ("rev", (Free, "some-rev"))
      , ("sha256", (Free, "some-sha"))
      , ("type", (Free, "tarball"))
      , ("url_template", (Free, "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"))
      ]
    expectedState = HMS.fromList
      [ ("owner", "nmattia")
      , ("repo", "niv")
      , ("homepage", "some-homepage")
      , ("description", "some-descr")
      , ("branch", "master")
      , ("url", "https://github.com/nmattia/niv/archive/new-rev.tar.gz")
      , ("rev", "new-rev")
      , ("sha256", "new-sha")
      , ("type", "tarball")
      , ("url_template", "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
      ]

test_githubDoesntOverrideRev :: IO ()
test_githubDoesntOverrideRev = do
    actualState <- evalUpdate initialState $ proc () ->
      githubUpdate prefetch latestRev ghRepo -< ()
    unless ((snd <$> actualState) == expectedState) $
      error $ "State mismatch: " <> show actualState
  where
    prefetch _ _ = pure "new-sha"
    latestRev _ _ _ = error "shouldn't fetch rev"
    ghRepo _ _ = error "shouldn't fetch repo"
    initialState = HMS.fromList
      [ ("owner", (Free, "nmattia"))
      , ("repo", (Free, "niv"))
      , ("homepage", (Free, "some-homepage"))
      , ("description", (Free, "some-descr"))
      , ("branch", (Free, "master"))
      , ("url", (Free, "https://github.com/nmattia/niv/archive/some-rev.tar.gz"))
      , ("rev", (Locked, "custom-rev"))
      , ("sha256", (Free, "some-sha"))
      , ("type", (Free, "tarball"))
      , ("url_template", (Free, "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"))
      ]
    expectedState = HMS.fromList
      [ ("owner", "nmattia")
      , ("repo", "niv")
      , ("homepage", "some-homepage")
      , ("description", "some-descr")
      , ("branch", "master")
      , ("url", "https://github.com/nmattia/niv/archive/custom-rev.tar.gz")
      , ("rev", "custom-rev")
      , ("sha256", "new-sha")
      , ("type", "tarball")
      , ("url_template", "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
      ]

-- TODO: HMS diff for test output
test_githubURLFallback :: IO ()
test_githubURLFallback = do
    actualState <- evalUpdate initialState $ proc () ->
      githubUpdate prefetch latestRev ghRepo -< ()
    unless ((snd <$> actualState) == expectedState) $
      error $ "State mismatch: " <> show actualState
  where
    prefetch _ _ = pure "some-sha"
    latestRev _ _ _ = error "shouldn't fetch rev"
    ghRepo _ _ = error "shouldn't fetch repo"
    initialState = HMS.fromList
      [ ("url_template", (Free, "https://foo.com/<baz>.tar.gz"))
      , ("baz", (Free, "tarball"))
      ]
    expectedState = HMS.fromList
      [ ("url_template", "https://foo.com/<baz>.tar.gz")
      , ("baz", "tarball")
      , ("url", "https://foo.com/tarball.tar.gz")
      , ("sha256", "some-sha")
      , ("type", "tarball")
      ]

test_githubUpdatesOnce :: IO ()
test_githubUpdatesOnce = do
    ioref <- newIORef False
    tmpState <- evalUpdate initialState $ proc () ->
      githubUpdate (prefetch ioref) latestRev ghRepo -< ()

    unless ((snd <$> tmpState) == expectedState) $
      error $ "State mismatch: " <> show tmpState

    -- Set everything free
    let tmpState' = HMS.map (first (\_ -> Free)) tmpState
    actualState <- evalUpdate tmpState' $ proc () ->
      githubUpdate (prefetch ioref) latestRev ghRepo -< ()

    unless ((snd <$> actualState) == expectedState) $
      error $ "State mismatch: " <> show actualState
  where
    prefetch ioref _ _ = do
      readIORef ioref >>= \case
        False -> pure ()
        True -> error "Prefetch should be called once!"
      writeIORef ioref True
      pure "new-sha"
    latestRev _ _ _ = pure "new-rev"
    ghRepo _ _ = pure GithubRepo
      { repoDescription = Just "some-descr"
      , repoHomepage = Just "some-homepage"
      , repoDefaultBranch = Just "master"
      }
    initialState = HMS.fromList
      [ ("owner", (Free, "nmattia"))
      , ("repo", (Free, "niv"))
      , ("homepage", (Free, "some-homepage"))
      , ("description", (Free, "some-descr"))
      , ("branch", (Free, "master"))
      , ("url", (Free, "https://github.com/nmattia/niv/archive/some-rev.tar.gz"))
      , ("rev", (Free, "some-rev"))
      , ("sha256", (Free, "some-sha"))
      , ("type", (Free, "tarball"))
      , ("url_template", (Free, "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"))
      ]
    expectedState = HMS.fromList
      [ ("owner", "nmattia")
      , ("repo", "niv")
      , ("homepage", "some-homepage")
      , ("description", "some-descr")
      , ("branch", "master")
      , ("url", "https://github.com/nmattia/niv/archive/new-rev.tar.gz")
      , ("rev", "new-rev")
      , ("sha256", "new-sha")
      , ("type", "tarball")
      , ("url_template", "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz")
      ]