Skip to content

Commit

Permalink
Move App version to app (#2121)
Browse files Browse the repository at this point in the history
* move app version from `swarm-engine` library to `swarm` executable
  * this removes `githash` dependency from the library
* part of #2109
  • Loading branch information
xsebek authored Aug 31, 2024
1 parent d1791a1 commit aeedebf
Show file tree
Hide file tree
Showing 6 changed files with 45 additions and 37 deletions.
31 changes: 22 additions & 9 deletions src/swarm-engine/Swarm/Version.hs → app/game/Swarm/Version.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)

Expand Down Expand Up @@ -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 mgi =
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
getNewerReleaseVersion :: Maybe GitInfo -> IO (Either (Severity, Text) String)
getNewerReleaseVersion mgi = first errToPair <$> getVer
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
8 changes: 4 additions & 4 deletions src/swarm-engine/Swarm/Game/State/Runtime.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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.
--
Expand Down
11 changes: 2 additions & 9 deletions src/swarm-tui/Swarm/TUI/Controller.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
--
Expand Down Expand Up @@ -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 ->
let sev = case e of
FailedReleaseQuery {} -> Error
OnDevelopmentBranch {} -> Info
_ -> Warning
in logReleaseEvent SystemLog sev e
Left (sev, e) -> runtimeState . eventLog %= logEvent SystemLog sev "Release" e
Right _ -> pure ()
runtimeState . upstreamRelease .= ev

Expand Down
3 changes: 1 addition & 2 deletions src/swarm-tui/Swarm/TUI/Model.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

------------------------------------------------------------
Expand All @@ -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
Expand Down
8 changes: 2 additions & 6 deletions src/swarm-tui/Swarm/TUI/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 (FailedReleaseQuery _f) -> Nothing
Left (NoMainUpstreamRelease _fails) -> Nothing
Left (OldUpstreamRelease _up _my) -> Nothing
Left _ -> Nothing

-- | When launching a game, a modal prompt may appear on another layer
-- to input seed and/or a script to run.
Expand Down
21 changes: 14 additions & 7 deletions swarm.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -428,18 +428,13 @@ 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,
extra >=1.7 && <1.8,
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,
Expand Down Expand Up @@ -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:
Expand Down

0 comments on commit aeedebf

Please sign in to comment.