{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} module TestPscPublish where import Prelude 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