Support pre-release versions for PureScript tool

.github/workflows/integration.yml

@@ -13,6 +13,8 @@ jobs:
     strategy:
       matrix:
         os: [ubuntu-latest, macos-latest, windows-latest]
+    env:
+      USE_LOCAL_VERSIONS_JSON: 1
 
     steps:
       - uses: actions/checkout@v2

README.md

@@ -36,7 +36,12 @@ Other tools are not enabled by default, but you can enable them by specifying th
 
 ### Specify Versions
 
-Each tool can accept a semantic version (only exact versions currently supported) or the string `"latest"`. Tools that are not installed by default must be specified this way to be included in the toolchain.
+Each tool can accept one of the following:
+- a semantic version (only exact versions currently supported)
+- the string `"latest"`, which represents the latest version that uses major, minor, and patch, but will omit versions using pre-release identifiers or build metadata
+- the string `"unstable"`, which represents the latest version no matter what it is (i.e. pre-release identifiers and build metadata are not considered).
+
+Tools that are not installed by default must be specified this way to be included in the toolchain.
 
 ```yaml
 steps:

dist/version-v2.json

@@ -0,0 +1,22 @@
+{
+  "purs": {
+    "unstable": "0.14.7",
+    "latest": "0.14.7"
+  },
+  "spago": {
+    "unstable": "0.20.7",
+    "latest": "0.20.7"
+  },
+  "psa": {
+    "unstable": "0.8.2",
+    "latest": "0.8.2"
+  },
+  "purs-tidy": {
+    "unstable": "0.7.0",
+    "latest": "0.7.0"
+  },
+  "zephyr": {
+    "unstable": "0.5.0-wip2",
+    "latest": "0.3.2"
+  }
+}

spago.dhall

@@ -7,19 +7,25 @@
   , "argonaut-core"
   , "arrays"
   , "bifunctors"
+  , "control"
   , "effect"
   , "either"
   , "enums"
   , "exceptions"
   , "foldable-traversable"
+  , "foreign-object"
   , "github-actions-toolkit"
   , "integers"
+  , "lists"
   , "math"
   , "maybe"
+  , "newtype"
   , "node-buffer"
   , "node-fs"
+  , "node-fs-aff"
   , "node-path"
   , "node-process"
+  , "ordered-collections"
   , "parsing"
   , "partial"
   , "prelude"

src/Main.purs

@@ -5,28 +5,40 @@ import Prelude
 import Affjax (printError)
 import Affjax as AX
 import Affjax.ResponseFormat as RF
-import Control.Monad.Except.Trans (ExceptT(..), mapExceptT, runExceptT)
-import Data.Bifunctor (lmap)
+import Control.Monad.Except.Trans (ExceptT(..), runExceptT)
+import Data.Argonaut.Parser (jsonParser)
+import Data.Bifunctor (bimap, lmap)
 import Data.Either (Either(..))
 import Data.Foldable (traverse_)
+import Data.Maybe (isJust)
 import Effect (Effect)
 import Effect.Aff (error, launchAff_, runAff_)
 import Effect.Class (liftEffect)
 import Effect.Exception (message)
 import GitHub.Actions.Core as Core
+import Node.Encoding (Encoding(..))
+import Node.FS.Aff as FSA
+import Node.Process as Process
 import Setup.BuildPlan (constructBuildPlan)
+import Setup.Data.VersionFiles (V2FileSchema(..), latestVersion)
 import Setup.GetTool (getTool)
 import Setup.UpdateVersions (updateVersions)
 
 main :: Effect Unit
 main = runAff_ go $ runExceptT do
-  versionsJson <- ExceptT $ map (lmap (error <<< printError)) $ AX.get RF.json versionsFile
-  tools <- mapExceptT liftEffect $ constructBuildPlan versionsJson.body
+  versionsJson <- getVersionsFile
+  tools <- constructBuildPlan versionsJson
   liftEffect $ Core.info "Constructed build plan."
   traverse_ getTool tools
   liftEffect $ Core.info "Fetched tools."
   where
-  versionsFile = "https://raw.githubusercontent.com/purescript-contrib/setup-purescript/main/dist/versions.json"
+  getVersionsFile = ExceptT do
+    let V2FileSchema { localFile, fileUrl } = latestVersion
+    mb <- liftEffect $ Process.lookupEnv "USE_LOCAL_VERSIONS_JSON"
+    if isJust mb then do
+      map (lmap error <<< jsonParser) $ FSA.readTextFile UTF8 localFile
+    else do
+      map (bimap (error <<< printError) _.body) $ AX.get RF.json fileUrl
 
   go res = case join res of
     Left err -> Core.setFailed (message err)

src/Setup/BuildPlan.purs

@@ -2,48 +2,54 @@ module Setup.BuildPlan (constructBuildPlan, BuildPlan) where
 
 import Prelude
 
-import Control.Monad.Except.Trans (ExceptT)
+import Control.Monad.Except.Trans (ExceptT, mapExceptT)
 import Data.Argonaut.Core (Json)
-import Data.Argonaut.Decode (decodeJson, printJsonDecodeError, (.:))
 import Data.Array as Array
-import Data.Bifunctor (lmap)
 import Data.Either (Either(..))
 import Data.Foldable (fold)
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Traversable (traverse)
 import Data.Version (Version)
 import Data.Version as Version
-import Effect (Effect)
-import Effect.Aff (error, throwError)
+import Effect.Aff (Aff, error, throwError)
 import Effect.Class (liftEffect)
 import Effect.Exception (Error)
 import GitHub.Actions.Core as Core
 import Setup.Data.Key (Key)
 import Setup.Data.Key as Key
 import Setup.Data.Tool (Tool)
 import Setup.Data.Tool as Tool
-import Text.Parsing.Parser (parseErrorMessage)
+import Setup.Data.VersionFiles (V2FileSchema(..), latestVersion, printV2FileError)
 import Text.Parsing.Parser as ParseError
 
 -- | The list of tools that should be downloaded and cached by the action
 type BuildPlan = Array { tool :: Tool, version :: Version }
 
 -- | Construct the list of tools that sholud be downloaded and cached by the action
-constructBuildPlan :: Json -> ExceptT Error Effect BuildPlan
+constructBuildPlan :: Json -> ExceptT Error Aff BuildPlan
 constructBuildPlan json = map Array.catMaybes $ traverse (resolve json) Tool.allTools
 
 -- | The parsed value of an input field that specifies a version
-data VersionField = Latest | Exact Version
+data VersionField
+  -- | Lookup the latest release, pre-release or not
+  = Unstable
+  -- | Lookup the latest release that is not a pre-release
+  | Latest
+  -- | Use the given version
+  | Exact Version
 
 -- | Attempt to read the value of an input specifying a tool version
-getVersionField :: Key -> ExceptT Error Effect (Maybe VersionField)
+getVersionField :: Key -> ExceptT Error Aff (Maybe VersionField)
 getVersionField key = do
-  value <- Core.getInput' (Key.toString key)
+  value <- mapExceptT liftEffect $ Core.getInput' (Key.toString key)
   case value of
     "" ->
       pure Nothing
     "latest" ->
       pure (pure Latest)
+    "unstable" ->
+      pure (pure Unstable)
     val -> case Version.parseVersion val of
       Left msg -> do
         liftEffect $ Core.error $ fold [ "Failed to parse version ", val ]
@@ -53,7 +59,7 @@ getVersionField key = do
 
 -- | Resolve the exact version to provide for a tool in the environment, based
 -- | on the action.yml file.
-resolve :: Json -> Tool -> ExceptT Error Effect (Maybe { tool :: Tool, version :: Version })
+resolve :: Json -> Tool -> ExceptT Error Aff (Maybe { tool :: Tool, version :: Version })
 resolve versionsContents tool = do
   let key = Key.fromTool tool
   field <- getVersionField key
@@ -65,16 +71,33 @@ resolve versionsContents tool = do
       pure (pure { tool, version: v })
 
     Just Latest -> liftEffect do
-      Core.info $ fold [ "Fetching latest tag for ", Tool.name tool ]
+      Core.info $ fold [ "Fetching latest stable tag for ", Tool.name tool ]
+      readVersionFromFile "latest" _.latest
 
-      let
-        version = lmap printJsonDecodeError $ (_ .: Tool.name tool) =<< decodeJson versionsContents
-        parse = lmap parseErrorMessage <<< Version.parseVersion
+    Just Unstable -> liftEffect do
+      Core.info $ fold [ "Fetching latest tag (pre-release or not) for ", Tool.name tool ]
+      readVersionFromFile "unstable" _.unstable
+  where
+  readVersionFromFile fieldName fieldSelector = do
+    let V2FileSchema { decode } = latestVersion
+    case decode versionsContents of
+      Left err -> do
+        Core.setFailed $ fold
+          [ "Unable to parse version for field '"
+          , fieldName
+          , "': "
+          , printV2FileError err
+          ]
+        throwError $ error "Unable to complete fetching version."
 
-      case parse =<< version of
-        Left e -> do
-          Core.setFailed $ fold [ "Unable to parse version: ", e ]
-          throwError $ error "Unable to complete fetching version."
-
-        Right v -> do
-          pure (pure { tool, version: v })
+      Right toolMap
+        | Just v <- Map.lookup tool toolMap -> do
+            pure (pure { tool, version: fieldSelector v })
+        | otherwise -> do
+            Core.setFailed $ fold
+              [ "Unable to find version for tool '"
+              , Tool.name tool
+              , "'. Tools found were: "
+              , show $ map Tool.name $ Array.fromFoldable $ Map.keys toolMap
+              ]
+            throwError $ error "Unable to complete fetching version."

src/Setup/Data/Tool.purs

@@ -3,12 +3,12 @@ module Setup.Data.Tool where
 import Prelude
 
 import Affjax (URL)
+import Data.Bounded.Generic (genericBottom, genericTop)
 import Data.Either (fromRight')
 import Data.Enum (class Enum, upFromIncluding)
+import Data.Enum.Generic (genericPred, genericSucc)
 import Data.Foldable (elem, fold)
 import Data.Generic.Rep (class Generic)
-import Data.Bounded.Generic (genericBottom, genericTop)
-import Data.Enum.Generic (genericPred, genericSucc)
 import Data.Version (Version, parseVersion)
 import Data.Version as Version
 import Node.Path (FilePath)

src/Setup/Data/VersionFiles.purs

@@ -0,0 +1,128 @@
+module Setup.Data.VersionFiles where
+
+import Prelude
+
+import Data.Argonaut.Core (Json, jsonEmptyObject)
+import Data.Argonaut.Decode (JsonDecodeError(..), decodeJson, printJsonDecodeError)
+import Data.Argonaut.Encode (encodeJson, (:=), (~>))
+import Data.Array (fold)
+import Data.Bifunctor (lmap)
+import Data.Either (Either(..))
+import Data.FoldableWithIndex (foldlWithIndex)
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
+import Data.TraversableWithIndex (forWithIndex)
+import Data.Tuple (Tuple(..))
+import Data.Version (Version)
+import Data.Version as Version
+import Foreign.Object (Object)
+import Setup.Data.Tool (Tool(..))
+import Text.Parsing.Parser (ParseError)
+
+latestVersion :: V2FileSchema
+latestVersion = version2
+
+data V2FileError
+  = JsonCodecError JsonDecodeError
+  | VersionParseError String ParseError
+  | ToolNameError JsonDecodeError
+
+printV2FileError :: V2FileError -> String
+printV2FileError = case _ of
+  JsonCodecError e -> printJsonDecodeError e
+  VersionParseError field e -> fold
+    [ "Version parse failure for key, "
+    , field
+    , "': "
+    , show e
+    ]
+  ToolNameError e -> fold
+    [ "Unable to convert String into Tool. "
+    , printJsonDecodeError e
+    ]
+
+type LatestUnstable a =
+  { latest :: a
+  , unstable :: a
+  }
+
+newtype V2FileSchema = V2FileSchema
+  { fileUrl :: String
+  , localFile :: String
+  , encode :: Map Tool (LatestUnstable Version) -> Json
+  , decode :: Json -> Either V2FileError (Map Tool (LatestUnstable Version))
+  }
+
+derive instance Newtype V2FileSchema _
+
+version2 :: V2FileSchema
+version2 = V2FileSchema
+  { fileUrl: "https://raw.githubusercontent.com/purescript-contrib/setup-purescript/main/dist/versions" <> vSuffix <> ".json"
+  , localFile: "./dist/version" <> vSuffix <> ".json"
+  , encode: foldlWithIndex encodeFoldFn jsonEmptyObject
+  , decode: \j -> do
+      obj :: Object Json <- lmap JsonCodecError $ decodeJson j
+      keyVals <- forWithIndex obj \key val -> do
+        tool <- strToTool key
+        { latest
+        , unstable
+        } :: LatestUnstable String <- lmap JsonCodecError $ decodeJson val
+        latest' <- lmap (VersionParseError (key <> ".latest")) $ Version.parseVersion latest
+        unstable' <- lmap (VersionParseError (key <> ".unstable")) $ Version.parseVersion unstable
+        pure $ Tuple tool { latest: latest', unstable: unstable' }
+      pure $ Map.fromFoldable keyVals
+  }
+  where
+  vSuffix = "-v2"
+  encodeFoldFn tool acc { latest, unstable }
+    | Just toolStr <- toolToMbString tool = do
+        let rec = { latest: Version.showVersion latest, unstable: Version.showVersion unstable }
+        toolStr := rec ~> acc
+    | otherwise =
+        acc
+
+  -- in case we add support for other tools in the future...
+  toolToMbString = case _ of
+    PureScript -> Just "purs"
+    Spago -> Just "spago"
+    Psa -> Just "psa"
+    PursTidy -> Just "purs-tidy"
+    Zephyr -> Just "zephyr"
+
+  strToTool = case _ of
+    "purs" -> Right PureScript
+    "spago" -> Right Spago
+    "psa" -> Right Psa
+    "purs-tidy" -> Right PursTidy
+    "zephyr" -> Right Zephyr
+    str -> Left $ ToolNameError $ UnexpectedValue $ encodeJson str
+
+newtype V1FileSchema = V1FileSchema
+  { localFile :: String
+  , encode :: Map Tool Version -> Json
+  }
+
+derive instance Newtype V1FileSchema _
+
+version1 :: V1FileSchema
+version1 = V1FileSchema
+  { localFile: "./dist/versions.json"
+  , encode: foldlWithIndex encodeFoldFn jsonEmptyObject
+  }
+  where
+  encodeFoldFn tool acc version
+    | Just toolStr <- printTool tool =
+        toolStr := Version.showVersion version ~> acc
+    | otherwise =
+        acc
+
+  -- We preserve the set of tools that existed at the time this version format was produced;
+  -- if more tools are added, they should map to `Nothing`
+  printTool = case _ of
+    PureScript -> Just "purs"
+    Spago -> Just "spago"
+    Psa -> Just "psa"
+    PursTidy -> Just "purs-tidy"
+    Zephyr -> Just "zephyr"