{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

module TestPscPublish where

import Prelude

import Control.Monad.IO.Class (liftIO)
import Data.ByteString.Lazy (ByteString)
import Data.Time.Clock (getCurrentTime)
import qualified Data.Aeson as A
import Data.Version
import Data.Foldable (forM_)
import qualified Text.PrettyPrint.Boxes as Boxes
import System.Directory (listDirectory)
import System.FilePath ((</>))

import Language.PureScript.Docs
import Language.PureScript.Publish
import Language.PureScript.Publish.ErrorsWarnings as Publish

import Test.Tasty
import Test.Tasty.Hspec (Spec, Expectation, runIO, context, it, expectationFailure, testSpec)
import TestUtils

main :: IO TestTree
main = testSpec "publish" spec

spec :: Spec
spec = do
  it "roundtrips the json for purescript-prelude" $ do
    testPackage
      "tests/support/bower_components/purescript-prelude"
      "../../prelude-resolutions.json"

  context "json compatibility" $ do
    let compatDir = "tests" </> "json-compat"
    versions <- runIO $ listDirectory compatDir
    forM_ versions $ \version -> do
      context ("json produced by " ++ version) $ do
        files <- runIO $ listDirectory (compatDir </> version)
        forM_ files $ \file -> do
          it file $ do
            result <- A.eitherDecodeFileStrict' (compatDir </> version </> file)
            case result of
              Right (_ :: VerifiedPackage) ->
                pure ()
              Left err ->
                expectationFailure ("JSON parsing failed: " ++ err)

data TestResult
  = ParseFailed String
  | Mismatch ByteString ByteString -- ^ encoding before, encoding after
  | Pass ByteString
  deriving (Show)

roundTrip :: UploadedPackage -> TestResult
roundTrip pkg =
  let before = A.encode pkg
  in case A.eitherDecode before of
       Left err -> ParseFailed err
       Right parsed -> do
         let after = A.encode (parsed :: UploadedPackage)
         if before == after
           then Pass before
           else Mismatch before after

testRunOptions :: PublishOptions
testRunOptions = defaultPublishOptions
  { publishGetVersion = return testVersion
  , publishGetTagTime = const (liftIO getCurrentTime)
  , publishWorkingTreeDirty = return ()
  }
  where testVersion = ("v999.0.0", Version [999,0,0] [])

-- | Given a directory which contains a package, produce JSON from it, and then
-- | attempt to parse it again, and ensure that it doesn't change.
testPackage :: FilePath -> FilePath -> Expectation
testPackage dir resolutionsFile = do
  res <- pushd dir (preparePackage "bower.json" resolutionsFile testRunOptions)
  case res of
    Left err ->
      expectationFailure $
        "Failed to produce JSON from " ++ dir ++ ":\n" ++
        Boxes.render (Publish.renderError err)
    Right package ->
      case roundTrip package of
        Pass _ ->
          pure ()
        ParseFailed msg ->
          expectationFailure ("Failed to re-parse: " ++ msg)
        Mismatch _ _ ->
          expectationFailure "JSON did not match"