summaryrefslogtreecommitdiff
path: root/tests/TestPscPublish.hs
blob: 49321edff668c4de36ffbc1d7bd8cd48b4cd25f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE ScopedTypeVariables #-}

module TestPscPublish where

import Control.Monad
import Control.Applicative
import Control.Exception
import System.Process
import System.Directory
import System.IO
import System.Exit
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Lazy (ByteString)
import qualified Data.Aeson as A
import Data.Aeson.BetterErrors
import Data.Version

import Language.PureScript.Docs
import Language.PureScript.Publish

import TestUtils

main :: IO ()
main = do
  testPackage "tests/support/prelude"

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

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
  , 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 :: String -> IO ()
testPackage dir = do
  pushd dir $ do
    r <- roundTrip <$> preparePackage testRunOptions
    case r of
      Pass _ -> do
        putStrLn ("psc-publish test passed for: " ++ dir)
        pure ()
      other -> do
        putStrLn ("psc-publish tests failed on " ++ dir ++ ":")
        putStrLn (show other)
        exitFailure