Move App version to app (#2121)

* move app version from `swarm-engine` library to `swarm` executable
  * this removes `githash` dependency from the library
* part of #2109

app/game/Swarm/Version.hs

@@ -18,12 +18,14 @@ module Swarm.Version (
 
 import Control.Exception (catch, displayException)
 import Data.Aeson (Array, Value (..), (.:))
+import Data.Bifunctor (first)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
 import Data.Char (isDigit)
 import Data.Either (lefts, rights)
 import Data.Foldable (toList)
 import Data.Maybe (listToMaybe)
+import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Version (Version (..), parseVersion, showVersion)
 import Data.Yaml (ParseException, Parser, decodeEither', parseEither)
@@ -39,6 +41,7 @@ import Network.HTTP.Client (
 import Network.HTTP.Client.TLS (tlsManagerSettings)
 import Network.HTTP.Types (hUserAgent)
 import Paths_swarm qualified
+import Swarm.Log
 import Swarm.Util (failT, quote)
 import Text.ParserCombinators.ReadP (readP_to_S)
 
@@ -152,21 +155,31 @@ normalize (Version ns tags) = Version (dropTrailing0 ns) tags
 --
 -- This function can fail if the current branch is not main,
 -- if there is no Internet connection or no newer release.
-getNewerReleaseVersion :: Maybe GitInfo -> IO (Either NewReleaseFailure String)
+getNewerReleaseVersion :: Maybe GitInfo -> IO (Either (Severity, Text) String)
-getNewerReleaseVersion mgi =
+getNewerReleaseVersion mgi = first errToPair <$> getVer
-  case mgi of
-    -- when using cabal install, the git info is unavailable, which is of no interest to players
-    Nothing -> (>>= getUpVer) <$> upstreamReleaseVersion
-    Just gi ->
-      if giBranch gi /= "main"
-        then return . Left . OnDevelopmentBranch $ giBranch gi
-        else (>>= getUpVer) <$> upstreamReleaseVersion
  where
   myVer :: Version
   myVer = Paths_swarm.version
+  getVer :: IO (Either NewReleaseFailure String)
+  getVer =
+    case mgi of
+      -- when using cabal install, the git info is unavailable, which is of no interest to players
+      Nothing -> (>>= getUpVer) <$> upstreamReleaseVersion
+      Just gi ->
+        if giBranch gi /= "main"
+          then return . Left . OnDevelopmentBranch $ giBranch gi
+          else (>>= getUpVer) <$> upstreamReleaseVersion
   getUpVer :: String -> Either NewReleaseFailure String
   getUpVer upTag =
     let upVer = tagToVersion upTag
      in if normalize myVer >= normalize upVer
           then Left $ OldUpstreamRelease upVer myVer
           else Right upTag
+  errToPair :: NewReleaseFailure -> (Severity, Text)
+  errToPair e = (toSev e, T.pack $ show e)
+  toSev :: NewReleaseFailure -> Severity
+  toSev = \case
+    FailedReleaseQuery {} -> Error
+    NoMainUpstreamRelease {} -> Warning
+    OnDevelopmentBranch {} -> Info
+    OldUpstreamRelease {} -> Warning

src/swarm-engine/Swarm/Game/State/Runtime.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- |
@@ -39,11 +40,10 @@ import Swarm.Game.State.Substate
 import Swarm.Game.World.Load (loadWorlds)
 import Swarm.Log
 import Swarm.Util.Lens (makeLensesNoSigs)
-import Swarm.Version (NewReleaseFailure (..))
 
 data RuntimeState = RuntimeState
   { _webPort :: Maybe Int
-  , _upstreamRelease :: Either NewReleaseFailure String
+  , _upstreamRelease :: Either (Severity, Text) String
   , _eventLog :: Notifications LogEntry
   , _scenarios :: ScenarioCollection
   , _stdGameConfigInputs :: GameStateConfig
@@ -99,7 +99,7 @@ initRuntimeState pause = do
   return $
     RuntimeState
       { _webPort = Nothing
-      , _upstreamRelease = Left (NoMainUpstreamRelease [])
+      , _upstreamRelease = Left (Info, "No upstream release found.")
       , _eventLog = mempty
       , _scenarios = scenarios
       , _appData = initAppDataMap gsc
@@ -112,7 +112,7 @@ makeLensesNoSigs ''RuntimeState
 webPort :: Lens' RuntimeState (Maybe Int)
 
 -- | The upstream release version.
-upstreamRelease :: Lens' RuntimeState (Either NewReleaseFailure String)
+upstreamRelease :: Lens' RuntimeState (Either (Severity, Text) String)
 
 -- | A log of runtime events.
 --

src/swarm-tui/Swarm/TUI/Controller.hs

@@ -105,7 +105,6 @@ import Swarm.TUI.Model.StateUpdate
 import Swarm.TUI.Model.Structure
 import Swarm.TUI.Model.UI
 import Swarm.Util hiding (both, (<<.=))
-import Swarm.Version (NewReleaseFailure (..))
 
 -- ~~~~ Note [liftA2 re-export from Prelude]
 --
@@ -138,16 +137,10 @@ handleEvent e = do
         then handleMainEvent upd e
         else handleMenuEvent e
 
-handleUpstreamVersionResponse :: Either NewReleaseFailure String -> EventM Name AppState ()
+handleUpstreamVersionResponse :: Either (Severity, Text) String -> EventM Name AppState ()
 handleUpstreamVersionResponse ev = do
-  let logReleaseEvent l sev e = runtimeState . eventLog %= logEvent l sev "Release" (T.pack $ show e)
   case ev of
-    Left e ->
+    Left (sev, e) -> runtimeState . eventLog %= logEvent SystemLog sev "Release" e
-      let sev = case e of
-            FailedReleaseQuery {} -> Error
-            OnDevelopmentBranch {} -> Info
-            _ -> Warning
-       in logReleaseEvent SystemLog sev e
     Right _ -> pure ()
   runtimeState . upstreamRelease .= ev
 

src/swarm-tui/Swarm/TUI/Model.hs

@@ -111,7 +111,6 @@ import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.UI
 import Swarm.TUI.Model.WebCommand (RejectionReason (..), WebCommand (..), WebInvocationState (..))
 import Swarm.Util.Lens (makeLensesNoSigs)
-import Swarm.Version (NewReleaseFailure)
 import Text.Fuzzy qualified as Fuzzy
 
 ------------------------------------------------------------
@@ -127,7 +126,7 @@ import Text.Fuzzy qualified as Fuzzy
 data AppEvent
   = Frame
   | Web WebCommand
-  | UpstreamVersion (Either NewReleaseFailure String)
+  | UpstreamVersion (Either (Severity, Text) String)
 
 infoScroll :: ViewportScroll Name
 infoScroll = viewportScroll InfoViewport

src/swarm-tui/Swarm/TUI/View.hs

@@ -151,7 +151,6 @@ import Swarm.TUI.View.Util as VU
 import Swarm.Util
 import Swarm.Util.UnitInterval
 import Swarm.Util.WindowedCounter qualified as WC
-import Swarm.Version (NewReleaseFailure (..))
 import System.Clock (TimeSpec (..))
 import Text.Printf
 import Text.Wrap
@@ -196,13 +195,10 @@ drawMainMenuUI s l =
   logo = s ^. runtimeState . appData . at "logo"
   version = s ^. runtimeState . upstreamRelease
 
-newVersionWidget :: Either NewReleaseFailure String -> Maybe (Widget n)
+newVersionWidget :: Either (Severity, Text) String -> Maybe (Widget n)
 newVersionWidget = \case
   Right ver -> Just . txt $ "New version " <> T.pack ver <> " is available!"
-  Left (OnDevelopmentBranch _b) -> Just . txt $ "Good luck developing!"
+  Left _ -> Nothing
-  Left (FailedReleaseQuery _f) -> Nothing
-  Left (NoMainUpstreamRelease _fails) -> Nothing
-  Left (OldUpstreamRelease _up _my) -> Nothing
 
 -- | When launching a game, a modal prompt may appear on another layer
 -- to input seed and/or a script to run.

swarm.cabal

@@ -18,6 +18,7 @@ description:
 
   * swarm-util: miscellaneous utilities
   * swarm-lang: parsing, typechecking, etc. for the Swarm language
+  * swarm-topography: working with location in 2D (sub-)worlds
   * swarm-scenario: scenario descriptions, parsing, & processing
   * swarm-engine: game simulation
   * swarm-doc: generating documentation
@@ -417,7 +418,6 @@ library swarm-engine
     Swarm.Game.Tick
     Swarm.Game.Value
     Swarm.Log
-    Swarm.Version
 
   other-modules: Paths_swarm
   autogen-modules: Paths_swarm
@@ -428,7 +428,6 @@ library swarm-engine
     astar >=0.3 && <0.3.1,
     base >=4.14 && <4.20,
     boolexpr >=0.2 && <0.3,
-    bytestring,
     clock >=0.8.2 && <0.9,
     containers >=0.6.2 && <0.8,
     directory >=1.3 && <1.4,
@@ -436,10 +435,6 @@ library swarm-engine
     filepath >=1.4 && <1.5,
     fused-effects >=1.1.1.1 && <1.2,
     fused-effects-lens >=1.2.0.1 && <1.3,
-    githash,
-    http-client >=0.7 && <0.8,
-    http-client-tls >=0.3 && <0.4,
-    http-types >=0.12 && <0.13,
     lens >=4.19 && <5.4,
     linear >=1.21.6 && <1.24,
     megaparsec >=9.6 && <9.7,
@@ -799,25 +794,37 @@ library swarm-tui
 executable swarm
   import: stan-config, common, ghc2021-extensions
   main-is: Main.hs
-  other-modules: Swarm.App
+  autogen-modules: Paths_swarm
+  other-modules:
+    Paths_swarm
+    Swarm.App
+    Swarm.Version
+
   build-depends:
     -- Imports shared with the library don't need bounds
+    aeson,
     base,
     brick,
+    bytestring,
     containers,
     extra,
     fused-effects,
     githash >=0.1.6 && <0.2,
+    http-client >=0.7 && <0.8,
+    http-client-tls >=0.3 && <0.4,
+    http-types >=0.12 && <0.13,
     lens,
     optparse-applicative >=0.16 && <0.19,
     swarm:swarm-engine,
     swarm:swarm-lang,
     swarm:swarm-scenario,
     swarm:swarm-tui,
+    swarm:swarm-util,
     swarm:swarm-web,
     text,
     vty,
     vty-crossplatform >=0.4 && <0.5,
+    yaml,
 
   hs-source-dirs: app/game
   ghc-options: