content: module TestPscPublish where
  
  import Prelude
  
  import Control.Exception (tryJust)
  import Control.Monad (void, guard)
  import Control.Monad.IO.Class (liftIO)
  import Data.ByteString.Lazy (ByteString)
  import Data.Time.Clock (getCurrentTime)
  import Data.Aeson qualified as A
  import Data.Version (Version(..))
  import Data.Foldable (forM_)
  import Text.PrettyPrint.Boxes qualified as Boxes
  import System.Directory (listDirectory, removeDirectoryRecursive)
  import System.FilePath ((</>))
  import System.IO.Error (isDoesNotExistError)
  
  import Language.PureScript.Docs (UploadedPackage, VerifiedPackage)
  import Language.PureScript.Publish (PublishOptions(..), defaultPublishOptions)
  import Language.PureScript.Publish qualified as Publish
  import Language.PureScript.Publish.ErrorsWarnings qualified as Publish
  
  import Test.Hspec (Expectation, Spec, context, expectationFailure, it, runIO)
  import TestUtils (pushd)
  
  spec :: Spec
  spec = do
    context "preparePackage with json roundtrips" $ do
      it "purescript-prelude" $ do
        testPackage
          "tests/support/bower_components/purescript-prelude"
          "bower.json"
          "../../prelude-resolutions.json"
  
      it "basic example (bower.json)" $ do
        testPackage
          "tests/purs/publish/basic-example"
          "bower.json"
          "resolutions.json"
  
      it "basic example (purs.json)" $ do
        testPackage
          "tests/purs/publish/basic-example"
          "purs.json"
          "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 :: FilePath -> FilePath -> PublishOptions
  testRunOptions manifestFile resolutionsFile = defaultPublishOptions
    { publishResolutionsFile = resolutionsFile
    , publishManifestFile = manifestFile
    , 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 -> FilePath -> Expectation
  testPackage packageDir manifestFile resolutionsFile = do
    res <- preparePackage packageDir manifestFile resolutionsFile
    case res of
      Left err ->
        expectationFailure $
          "Failed to produce JSON from " ++ packageDir ++ ":\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"
  
  -- A version of Publish.preparePackage suitable for use in tests. We remove the
  -- output directory each time to ensure that we are actually testing the docs
  -- code in the working tree as it is now (as opposed to how it was at some
  -- point in the past when the tests were previously successfully run).
  preparePackage :: FilePath -> FilePath -> FilePath -> IO (Either Publish.PackageError UploadedPackage)
  preparePackage packageDir manifestFile resolutionsFile =
    pushd packageDir $ do
      removeDirectoryRecursiveIfPresent "output"
      Publish.preparePackage (testRunOptions manifestFile resolutionsFile)
  
  removeDirectoryRecursiveIfPresent :: FilePath -> IO ()
  removeDirectoryRecursiveIfPresent =
    void . tryJust (guard . isDoesNotExistError) . removeDirectoryRecursive
  