{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE OverloadedStrings #-}

module TestPscPublish where

import Control.Monad.IO.Class (liftIO)

import System.Exit (exitFailure)

import Data.ByteString.Lazy (ByteString)

import Data.Time.Clock (getCurrentTime)

import qualified Data.Aeson as A

import Data.Version

import Language.PureScript.Docs

import Language.PureScript.Publish

import Language.PureScript.Publish.ErrorsWarnings as Publish

import TestUtils

main :: IO ()

main = testPackage

"tests/support/bower_components/purescript-prelude"

"../../prelude-resolutions.json"

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 -> IO ()

testPackage dir resolutionsFile = pushd dir $ do

res <- preparePackage "bower.json" resolutionsFile testRunOptions

case res of

Left e -> preparePackageError e

Right package -> case roundTrip package of

Pass _ -> do

putStrLn ("psc-publish test passed for: " ++ dir)

pure ()

other -> do

putStrLn ("psc-publish tests failed on " ++ dir ++ ":")

print other

exitFailure

where

preparePackageError e = Publish.printErrorToStdout e >> exitFailure