From 7f53d9061dfdd8230607ae1d4a8e2d2fda7e09aa Mon Sep 17 00:00:00 2001 From: Brent Yorgey Date: Tue, 11 Jul 2023 19:05:14 -0500 Subject: [PATCH] Update to support GHC 9.6, `mtl-2.3`, and bump upper bounds (#1363) Support GHC 9.6 / `base-4.18`, `mtl-2.3`, `megaparsec-9.4`, `servant-0.20`, `servant-docs-0.13`, `servant-server-0.20`, `template-haskell-2.20`, `optparse-applicative-0.18`, fix a bunch of new warnings, and update CI to test on GHC 9.6. --------- Co-authored-by: restyled-io[bot] <32688539+restyled-io[bot]@users.noreply.github.com> Co-authored-by: Restyled.io --- .github/workflows/haskell-ci.yml | 67 +++++++++++++++++++----------- .mergify.yml | 10 +++-- cabal.haskell-ci | 2 +- src/Swarm/App.hs | 4 +- src/Swarm/Doc/Gen.hs | 5 ++- src/Swarm/Doc/Pedagogy.hs | 5 ++- src/Swarm/Game/Recipe.hs | 23 ++++++---- src/Swarm/Game/ResourceLoading.hs | 7 ++-- src/Swarm/Game/Robot.hs | 9 ++-- src/Swarm/Game/Scenario.hs | 9 ++-- src/Swarm/Game/ScenarioInfo.hs | 15 +++---- src/Swarm/Game/State.hs | 12 ++++-- src/Swarm/Game/Step.hs | 4 +- src/Swarm/Game/World.hs | 7 ++-- src/Swarm/Language/Key.hs | 3 +- src/Swarm/Language/Parse.hs | 6 ++- src/Swarm/Language/Typecheck.hs | 14 ++++++- src/Swarm/Language/Types.hs | 3 +- src/Swarm/TUI/Controller.hs | 20 +++++++-- src/Swarm/TUI/Launch/Controller.hs | 3 +- src/Swarm/TUI/Model.hs | 8 ++-- src/Swarm/TUI/Model/Repl.hs | 1 + src/Swarm/TUI/Model/StateUpdate.hs | 6 ++- src/Swarm/TUI/Model/UI.hs | 3 +- swarm.cabal | 18 ++++---- test/unit/TestUtil.hs | 5 ++- 26 files changed, 174 insertions(+), 95 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 3ad9fbad..e7ab7ec7 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -17,9 +17,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.15.20221009 +# version: 0.16.3 # -# REGENDATA ("0.15.20221009",["github","--config=cabal.haskell-ci","--copy-fields=all","swarm.cabal"]) +# REGENDATA ("0.16.3",["github","--config=cabal.haskell-ci","--copy-fields=all","swarm.cabal"]) # name: Haskell-CI on: @@ -57,14 +57,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.4.2 + - compiler: ghc-9.6.2 compilerKind: ghc - compilerVersion: 9.4.2 + compilerVersion: 9.6.2 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.4 + - compiler: ghc-9.4.5 compilerKind: ghc - compilerVersion: 9.2.4 + compilerVersion: 9.4.5 + setup-method: ghcup + allow-failure: false + - compiler: ghc-9.2.7 + compilerKind: ghc + compilerVersion: 9.2.7 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -84,10 +89,10 @@ jobs: apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: HCKIND: ${{ matrix.compilerKind }} HCNAME: ${{ matrix.compiler }} @@ -103,7 +108,7 @@ jobs: echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" @@ -151,15 +156,15 @@ jobs: run: | $CABAL v2-update -v - name: cache (tools) - uses: actions/cache@v2 + uses: actions/cache/restore@v3 with: - key: ${{ runner.os }}-${{ matrix.compiler }}-tools-0367592e + key: ${{ runner.os }}-${{ matrix.compiler }}-tools-1d2d1963 path: ~/.haskell-ci-tools - name: install cabal-plan run: | mkdir -p $HOME/.cabal/bin - curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz - echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - + curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz + echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan rm -f cabal-plan.xz chmod a+x $HOME/.cabal/bin/cabal-plan @@ -167,20 +172,26 @@ jobs: - name: install cabal-docspec run: | mkdir -p $HOME/.cabal/bin - curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20211114/cabal-docspec-0.0.0.20211114.xz > cabal-docspec.xz - echo 'e224700d9e8c9ec7ec6bc3f542ba433cd9925a5d356676c62a9bd1f2c8be8f8a cabal-docspec.xz' | sha256sum -c - + curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20230517/cabal-docspec-0.0.0.20230517-x86_64-linux.xz > cabal-docspec.xz + echo '3b31bbe463ad4d671abbc103db49628562ec48a6604cab278207b5b6acd21ed7 cabal-docspec.xz' | sha256sum -c - xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec rm -f cabal-docspec.xz chmod a+x $HOME/.cabal/bin/cabal-docspec cabal-docspec --version - name: install hlint run: | - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint --constraint='hlint >=3.5 && <3.6' | perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then hlint --version ; fi + if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint --constraint='hlint >=3.5 && <3.6' | perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi + if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi + if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi + if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then hlint --version ; fi + - name: save cache (tools) + uses: actions/cache/save@v3 + if: always() + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-tools-1d2d1963 + path: ~/.haskell-ci-tools - name: checkout - uses: actions/checkout@v2 + uses: actions/checkout@v3 with: path: source - name: initial cabal.project for sdist @@ -216,8 +227,8 @@ jobs: run: | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all cabal-plan - - name: cache - uses: actions/cache@v2 + - name: restore cache + uses: actions/cache/restore@v3 with: key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} path: ~/.cabal/store @@ -238,12 +249,18 @@ jobs: cabal-docspec $ARG_COMPILER - name: hlint run: | - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src) ; fi - if [ $((HCNUMVER >= 90400)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XImportQualifiedPost app) ; fi + if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XBangPatterns -XDeriveAnyClass -XDeriveDataTypeable -XDeriveFunctor -XDeriveGeneric -XDeriveTraversable -XExplicitForAll -XFlexibleContexts -XFlexibleInstances -XGADTSyntax -XMultiParamTypeClasses -XNumericUnderscores -XRankNTypes -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeOperators -XImportQualifiedPost -XLambdaCase -XStrictData src) ; fi + if [ $((HCNUMVER >= 90400 && HCNUMVER < 90600)) -ne 0 ] ; then (cd ${PKGDIR_swarm} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 -XImportQualifiedPost app) ; fi - name: cabal check run: | cd ${PKGDIR_swarm} || false ${CABAL} -vnormal check - name: haddock run: | - $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all + $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all + - name: save cache + uses: actions/cache/save@v3 + if: always() + with: + key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} + path: ~/.cabal/store diff --git a/.mergify.yml b/.mergify.yml index 16c4b5e8..d6bd18ea 100644 --- a/.mergify.yml +++ b/.mergify.yml @@ -14,8 +14,9 @@ queue_rules: - or: - check-success=Enforce issue references - -files~=\.hs$ - - check-success=Haskell-CI - Linux - ghc-9.4.2 - - check-success=Haskell-CI - Linux - ghc-9.2.4 + - check-success=Haskell-CI - Linux - ghc-9.6.2 + - check-success=Haskell-CI - Linux - ghc-9.4.5 + - check-success=Haskell-CI - Linux - ghc-9.2.7 - check-success=Haskell-CI - Linux - ghc-9.0.2 - check-success=Haskell-CI - Linux - ghc-8.10.7 @@ -44,8 +45,9 @@ pull_request_rules: - or: - check-success=Enforce issue references - -files~=\.hs$ - - check-success=Haskell-CI - Linux - ghc-9.4.2 - - check-success=Haskell-CI - Linux - ghc-9.2.4 + - check-success=Haskell-CI - Linux - ghc-9.6.2 + - check-success=Haskell-CI - Linux - ghc-9.4.5 + - check-success=Haskell-CI - Linux - ghc-9.2.7 - check-success=Haskell-CI - Linux - ghc-9.0.2 - check-success=Haskell-CI - Linux - ghc-8.10.7 - label=merge me diff --git a/cabal.haskell-ci b/cabal.haskell-ci index 11e5d435..289d40f3 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -19,7 +19,7 @@ benchmarks: True -- Run HLint hlint: True -hlint-job: 9.4.2 +hlint-job: 9.4.5 hlint-yaml: .hlint.yaml hlint-download-binary: True diff --git a/src/Swarm/App.hs b/src/Swarm/App.hs index e9a31a3c..1bf3a503 100644 --- a/src/Swarm/App.hs +++ b/src/Swarm/App.hs @@ -10,7 +10,9 @@ import Brick import Brick.BChan import Control.Concurrent (forkIO, threadDelay) import Control.Lens (view, (%~), (&), (?~)) -import Control.Monad.Except +import Control.Monad (forever, void, when) +import Control.Monad.Except (runExceptT) +import Control.Monad.IO.Class (liftIO) import Data.IORef (newIORef, writeIORef) import Data.Text qualified as T import Data.Text.IO qualified as T diff --git a/src/Swarm/Doc/Gen.hs b/src/Swarm/Doc/Gen.hs index e320f28f..f8ca2986 100644 --- a/src/Swarm/Doc/Gen.hs +++ b/src/Swarm/Doc/Gen.hs @@ -27,7 +27,8 @@ import Control.Arrow (left) import Control.Lens (view, (^.)) import Control.Lens.Combinators (to) import Control.Monad (zipWithM, zipWithM_) -import Control.Monad.Except (ExceptT (..), liftIO, runExceptT, withExceptT) +import Control.Monad.Except (ExceptT (..), runExceptT, withExceptT) +import Control.Monad.IO.Class (liftIO) import Data.Containers.ListUtils (nubOrd) import Data.Either.Extra (eitherToMaybe) import Data.Foldable (find, toList) @@ -232,7 +233,7 @@ maxWidths = map (maximum . map T.length) . transpose addLink :: Text -> Text -> Text addLink l t = T.concat ["[", t, "](", l, ")"] -tshow :: Show a => a -> Text +tshow :: (Show a) => a -> Text tshow = T.pack . show -- --------- diff --git a/src/Swarm/Doc/Pedagogy.hs b/src/Swarm/Doc/Pedagogy.hs index 6adf3c44..cc0a59bb 100644 --- a/src/Swarm/Doc/Pedagogy.hs +++ b/src/Swarm/Doc/Pedagogy.hs @@ -19,7 +19,8 @@ module Swarm.Doc.Pedagogy ( import Control.Arrow ((&&&)) import Control.Lens (universe, view) import Control.Monad (guard, (<=<)) -import Control.Monad.Except (ExceptT (..), liftIO) +import Control.Monad.Except (ExceptT (..)) +import Control.Monad.IO.Class (liftIO) import Data.List (foldl', intercalate, sort, sortOn) import Data.List.Extra (zipFrom) import Data.Map (Map) @@ -183,7 +184,7 @@ renderUsagesMarkdown (CoverageInfo (TutorialInfo (s, si) idx _sCmds dCmds) novel , renderTutorialTitle idx s ] -renderTutorialTitle :: Show a => a -> Scenario -> Text +renderTutorialTitle :: (Show a) => a -> Scenario -> Text renderTutorialTitle idx s = T.unwords [ T.pack $ show idx <> ":" diff --git a/src/Swarm/Game/Recipe.hs b/src/Swarm/Game/Recipe.hs index 3bca3a2c..bf8277ae 100644 --- a/src/Swarm/Game/Recipe.hs +++ b/src/Swarm/Game/Recipe.hs @@ -33,7 +33,8 @@ module Swarm.Game.Recipe ( import Control.Arrow (left) import Control.Lens hiding (from, (.=)) -import Control.Monad.Except (ExceptT (..), MonadIO, liftIO, withExceptT) +import Control.Monad.Except (ExceptT (..), withExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (except) import Data.Bifunctor (second) import Data.Either.Validation @@ -112,11 +113,19 @@ instance ToJSON (Recipe Text) where instance FromJSON (Recipe Text) where parseJSON = withObject "Recipe" $ \v -> Recipe - <$> v .: "in" - <*> v .: "out" - <*> v .:? "required" .!= [] - <*> v .:? "time" .!= 1 - <*> v .:? "weight" .!= 1 + <$> v + .: "in" + <*> v + .: "out" + <*> v + .:? "required" + .!= [] + <*> v + .:? "time" + .!= 1 + <*> v + .:? "weight" + .!= 1 -- | Given an 'EntityMap', turn a list of recipes containing /names/ -- of entities into a list of recipes containing actual 'Entity' @@ -137,7 +146,7 @@ instance FromJSONE EntityMap (Recipe Entity) where -- | Given an already loaded 'EntityMap', try to load a list of -- recipes from the data file @recipes.yaml@. loadRecipes :: - MonadIO m => + (MonadIO m) => EntityMap -> ExceptT SystemFailure m [Recipe Entity] loadRecipes em = do diff --git a/src/Swarm/Game/ResourceLoading.hs b/src/Swarm/Game/ResourceLoading.hs index d3ebe38d..0662e54b 100644 --- a/src/Swarm/Game/ResourceLoading.hs +++ b/src/Swarm/Game/ResourceLoading.hs @@ -9,7 +9,8 @@ module Swarm.Game.ResourceLoading where import Control.Exception (catch) import Control.Exception.Base (IOException) import Control.Monad (forM, when) -import Control.Monad.Except (ExceptT (..), MonadIO, liftIO) +import Control.Monad.Except (ExceptT (..)) +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Map (Map) import Data.Map qualified as M import Data.Maybe (mapMaybe) @@ -37,7 +38,7 @@ import Witch -- The idea is that when installing with Cabal/Stack the first -- is preferred, but when the players install a binary they -- need to extract the `data` archive to the XDG directory. -getDataDirSafe :: MonadIO m => AssetData -> FilePath -> m (Either SystemFailure FilePath) +getDataDirSafe :: (MonadIO m) => AssetData -> FilePath -> m (Either SystemFailure FilePath) getDataDirSafe asset p = do d <- (`appDir` p) <$> liftIO getDataDir de <- liftIO $ doesDirectoryExist d @@ -57,7 +58,7 @@ getDataDirSafe asset p = do -- -- See the note in 'getDataDirSafe'. getDataFileNameSafe :: - MonadIO m => + (MonadIO m) => AssetData -> FilePath -> ExceptT SystemFailure m FilePath diff --git a/src/Swarm/Game/Robot.hs b/src/Swarm/Game/Robot.hs index cd46ca30..01c0664d 100644 --- a/src/Swarm/Game/Robot.hs +++ b/src/Swarm/Game/Robot.hs @@ -79,6 +79,7 @@ module Swarm.Game.Robot ( import Control.Lens hiding (contains) import Data.Aeson (FromJSON, ToJSON) import Data.Hashable (hashWithSalt) +import Data.Kind qualified import Data.Maybe (fromMaybe, isNothing) import Data.Sequence (Seq) import Data.Sequence qualified as Seq @@ -165,12 +166,12 @@ data RobotPhase -- | With a robot template, we may or may not have a location. With a -- concrete robot we must have a location. -type family RobotLocation (phase :: RobotPhase) :: * where +type family RobotLocation (phase :: RobotPhase) :: Data.Kind.Type where RobotLocation 'TemplateRobot = Maybe Location RobotLocation 'ConcreteRobot = Location -- | Robot templates have no ID; concrete robots definitely do. -type family RobotID (phase :: RobotPhase) :: * where +type family RobotID (phase :: RobotPhase) :: Data.Kind.Type where RobotID 'TemplateRobot = () RobotID 'ConcreteRobot = RID @@ -520,7 +521,7 @@ isActive = isNothing . getResult -- | "Active" robots include robots that are waiting; 'wantsToStep' is -- true if the robot actually wants to take another step right now --- (this is a *subset* of active robots). +-- (this is a /subset/ of active robots). wantsToStep :: TickNumber -> Robot -> Bool wantsToStep now robot | not (isActive robot) = False @@ -538,5 +539,5 @@ getResult :: Robot -> Maybe (Value, Store) {-# INLINE getResult #-} getResult = finalValue . view machine -hearingDistance :: Num i => i +hearingDistance :: (Num i) => i hearingDistance = 32 diff --git a/src/Swarm/Game/Scenario.hs b/src/Swarm/Game/Scenario.hs index 6534ffc2..f1960ea6 100644 --- a/src/Swarm/Game/Scenario.hs +++ b/src/Swarm/Game/Scenario.hs @@ -47,7 +47,8 @@ module Swarm.Game.Scenario ( import Control.Lens hiding (from, (.=), (<.>)) import Control.Monad (filterM) -import Control.Monad.Except (ExceptT (..), MonadIO, liftIO, runExceptT, withExceptT) +import Control.Monad.Except (ExceptT (..), runExceptT, withExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (except) import Data.Aeson import Data.Either.Extra (eitherToMaybe, maybeToEither) @@ -201,7 +202,7 @@ scenarioStepsPerTick :: Lens' Scenario (Maybe Int) ------------------------------------------------------------ getScenarioPath :: - MonadIO m => + (MonadIO m) => FilePath -> m (Maybe FilePath) getScenarioPath scenario = do @@ -216,7 +217,7 @@ getScenarioPath scenario = do -- to use. This function is used if a specific scenario is -- requested on the command line. loadScenario :: - MonadIO m => + (MonadIO m) => String -> EntityMap -> ExceptT Text m (Scenario, FilePath) @@ -228,7 +229,7 @@ loadScenario scenario em = do -- | Load a scenario from a file. loadScenarioFile :: - MonadIO m => + (MonadIO m) => EntityMap -> FilePath -> ExceptT SystemFailure m Scenario diff --git a/src/Swarm/Game/ScenarioInfo.hs b/src/Swarm/Game/ScenarioInfo.hs index 48564ef8..5c34d3b4 100644 --- a/src/Swarm/Game/ScenarioInfo.hs +++ b/src/Swarm/Game/ScenarioInfo.hs @@ -40,7 +40,8 @@ module Swarm.Game.ScenarioInfo ( import Control.Lens hiding (from, (<.>)) import Control.Monad (filterM, unless, when) -import Control.Monad.Except (ExceptT (..), MonadIO, liftIO, runExceptT, withExceptT) +import Control.Monad.Except (ExceptT (..), runExceptT, withExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Char (isSpace) import Data.Either.Extra (fromRight') import Data.List (intercalate, isPrefixOf, stripPrefix, (\\)) @@ -87,7 +88,7 @@ scenarioItemByPath :: FilePath -> Traversal' ScenarioCollection ScenarioItem scenarioItemByPath path = ixp ps where ps = splitDirectories path - ixp :: Applicative f => [String] -> (ScenarioItem -> f ScenarioItem) -> ScenarioCollection -> f ScenarioCollection + ixp :: (Applicative f) => [String] -> (ScenarioItem -> f ScenarioItem) -> ScenarioCollection -> f ScenarioCollection ixp [] _ col = pure col ixp [s] f (SC n m) = SC n <$> ix s f m ixp (d : xs) f (SC n m) = SC n <$> ix d inner m @@ -98,7 +99,7 @@ scenarioItemByPath path = ixp ps -- | Canonicalize a scenario path, making it usable as a unique key. normalizeScenarioPath :: - MonadIO m => + (MonadIO m) => ScenarioCollection -> FilePath -> m FilePath @@ -147,7 +148,7 @@ orderFileName :: FilePath orderFileName = "00-ORDER.txt" readOrderFile :: - MonadIO m => + (MonadIO m) => FilePath -> ExceptT [SystemFailure] m [String] readOrderFile orderFile = @@ -156,7 +157,7 @@ readOrderFile orderFile = -- | Recursively load all scenarios from a particular directory, and also load -- the 00-ORDER file (if any) giving the order for the scenarios. loadScenarioDir :: - MonadIO m => + (MonadIO m) => EntityMap -> FilePath -> ExceptT [SystemFailure] m ([SystemFailure], ScenarioCollection) @@ -229,7 +230,7 @@ scenarioPathToSavePath path swarmData = swarmData Data.List.intercalate "_" -- | Load saved info about played scenario from XDG data directory. loadScenarioInfo :: - MonadIO m => + (MonadIO m) => FilePath -> ExceptT [SystemFailure] m ScenarioInfo loadScenarioInfo p = do @@ -258,7 +259,7 @@ saveScenarioInfo path si = do -- | Load a scenario item (either a scenario, or a subdirectory -- containing a collection of scenarios) from a particular path. loadScenarioItem :: - MonadIO m => + (MonadIO m) => EntityMap -> FilePath -> ExceptT [SystemFailure] m ([SystemFailure], ScenarioItem) diff --git a/src/Swarm/Game/State.hs b/src/Swarm/Game/State.hs index ea7078d4..971255d2 100644 --- a/src/Swarm/Game/State.hs +++ b/src/Swarm/Game/State.hs @@ -126,7 +126,8 @@ import Control.Arrow (Arrow ((&&&)), left) import Control.Effect.Lens import Control.Effect.State (State) import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=)) -import Control.Monad.Except +import Control.Monad (forM_) +import Control.Monad.Except (ExceptT (..)) import Data.Aeson (FromJSON, ToJSON) import Data.Array (Array, listArray) import Data.Bifunctor (first) @@ -1102,16 +1103,19 @@ scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun)) -- Note that this *replaces* any program the base robot otherwise -- would have run (i.e. any program specified in the program: field -- of the scenario description). - & ix baseID . machine + & ix baseID + . machine %~ case initialCodeToRun of Nothing -> id Just pt -> const $ initMachine pt Ctx.empty emptyStore -- If we are in creative mode, give base all the things - & ix baseID . robotInventory + & ix baseID + . robotInventory %~ case scenario ^. scenarioCreative of False -> id True -> union (fromElems (map (0,) things)) - & ix baseID . equippedDevices + & ix baseID + . equippedDevices %~ case scenario ^. scenarioCreative of False -> id True -> const (fromList devices) diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index 89ca0f15..e3d2c2cc 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -21,7 +21,7 @@ -- See . module Swarm.Game.Step where -import Control.Applicative (liftA2) +import Control.Applicative (Applicative (..)) import Control.Arrow ((&&&)) import Control.Carrier.Error.Either (ErrorC, runError) import Control.Carrier.State.Lazy @@ -93,7 +93,7 @@ import System.Clock (TimeSpec) import System.Clock qualified import System.Random (UniformRange, uniformR) import Witch (From (from), into) -import Prelude hiding (lookup) +import Prelude hiding (Applicative (..), lookup) -- | The main function to do one game tick. -- diff --git a/src/Swarm/Game/World.hs b/src/Swarm/Game/World.hs index 4e772875..c32e919b 100644 --- a/src/Swarm/Game/World.hs +++ b/src/Swarm/Game/World.hs @@ -100,6 +100,7 @@ type BoundsRectangle = (Coords, Coords) -- (exactly one per cell) and entities of type @e@ (at most one per -- cell). newtype WorldFun t e = WF {runWF :: Coords -> (t, Maybe e)} + deriving (Functor) instance Bifunctor WorldFun where bimap g h (WF z) = WF (bimap g (fmap h) . z) @@ -219,7 +220,7 @@ emptyWorld t = newWorld (WF $ const (t, Nothing)) -- -- This function does /not/ ensure that the tile containing the -- given coordinates is loaded. For that, see 'lookupTerrainM'. -lookupTerrain :: IArray U.UArray t => Coords -> World t e -> t +lookupTerrain :: (IArray U.UArray t) => Coords -> World t e -> t lookupTerrain i (World f t _) = ((U.! tileOffset i) . fst <$> M.lookup (tileCoords i) t) ? fst (runWF f i) @@ -277,12 +278,12 @@ updateM c g = do state @(World t Entity) $ update c g . loadCell c -- | Load the tile containing a specific cell. -loadCell :: IArray U.UArray t => Coords -> World t e -> World t e +loadCell :: (IArray U.UArray t) => Coords -> World t e -> World t e loadCell c = loadRegion (c, c) -- | Load all the tiles which overlap the given rectangular region -- (specified as an upper-left and lower-right corner, inclusive). -loadRegion :: forall t e. IArray U.UArray t => (Coords, Coords) -> World t e -> World t e +loadRegion :: forall t e. (IArray U.UArray t) => (Coords, Coords) -> World t e -> World t e loadRegion reg (World f t m) = World f t' m where tiles = range (over both tileCoords reg) diff --git a/src/Swarm/Language/Key.hs b/src/Swarm/Language/Key.hs index 8efb0e1a..3ae2a8fd 100644 --- a/src/Swarm/Language/Key.hs +++ b/src/Swarm/Language/Key.hs @@ -20,6 +20,7 @@ where import Data.Aeson (FromJSON, ToJSON) import Data.Foldable (asum) +import Data.Kind qualified import Data.List (sort, (\\)) import Data.Set (Set) import Data.Set qualified as S @@ -102,7 +103,7 @@ specialKeyParser t = read . ('K' :) . from @Text <$> string t specialKeyNames :: Set Text specialKeyNames = S.fromList . map T.tail $ (names' @(Rep V.Key) \\ ["KChar", "KFun"]) -class Names' (f :: * -> *) where +class Names' (f :: Data.Kind.Type -> Data.Kind.Type) where names' :: [Text] instance (Names' f) => Names' (M1 D t f) where names' = names' @f diff --git a/src/Swarm/Language/Parse.hs b/src/Swarm/Language/Parse.hs index 54405819..52765783 100644 --- a/src/Swarm/Language/Parse.hs +++ b/src/Swarm/Language/Parse.hs @@ -34,8 +34,12 @@ module Swarm.Language.Parse ( ) where import Control.Lens (view, (^.)) +import Control.Monad (guard, join) import Control.Monad.Combinators.Expr -import Control.Monad.Reader +import Control.Monad.Reader ( + MonadReader (ask), + ReaderT (runReaderT), + ) import Data.Bifunctor import Data.Foldable (asum) import Data.List (foldl', nub) diff --git a/src/Swarm/Language/Typecheck.hs b/src/Swarm/Language/Typecheck.hs index 05175b8e..85ea3d7b 100644 --- a/src/Swarm/Language/Typecheck.hs +++ b/src/Swarm/Language/Typecheck.hs @@ -57,8 +57,18 @@ import Control.Arrow ((***)) import Control.Category ((>>>)) import Control.Lens ((^.)) import Control.Lens.Indexed (itraverse) -import Control.Monad.Except -import Control.Monad.Reader +import Control.Monad (forM_, void, when) +import Control.Monad.Except ( + ExceptT, + MonadError (catchError, throwError), + runExceptT, + ) +import Control.Monad.Reader ( + MonadReader (ask, local), + ReaderT (runReaderT), + mapReaderT, + ) +import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Unification hiding (applyBindings, unify, (=:=)) import Control.Unification qualified as U import Control.Unification.IntVar diff --git a/src/Swarm/Language/Types.hs b/src/Swarm/Language/Types.hs index 51ce2b60..af0f3112 100644 --- a/src/Swarm/Language/Types.hs +++ b/src/Swarm/Language/Types.hs @@ -79,6 +79,7 @@ import Data.Data (Data) import Data.Foldable (fold) import Data.Function (on) import Data.Functor.Fixedpoint +import Data.Kind qualified import Data.Map.Merge.Strict qualified as M import Data.Map.Strict (Map) import Data.Map.Strict qualified as M @@ -247,7 +248,7 @@ type UPolytype = Poly UType -- used only on inputs that are safe. class WithU t where -- | The associated "@U@-version" of the type @t@. - type U t :: * + type U t :: Data.Kind.Type -- | Convert from @t@ to its associated "@U@-version". This -- direction is always safe (we simply have no unification diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs index 98c906f4..bc387499 100644 --- a/src/Swarm/TUI/Controller.hs +++ b/src/Swarm/TUI/Controller.hs @@ -44,13 +44,15 @@ import Brick.Widgets.Dialog import Brick.Widgets.Edit (handleEditorEvent) import Brick.Widgets.List (handleListEvent) import Brick.Widgets.List qualified as BL +import Control.Applicative (liftA2, pure) import Control.Carrier.Lift qualified as Fused import Control.Carrier.State.Lazy qualified as Fused import Control.Lens as Lens import Control.Lens.Extras as Lens (is) -import Control.Monad.Except +import Control.Monad (forM_, unless, void, when) import Control.Monad.Extra (whenJust) -import Control.Monad.State +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.State (MonadState, execState) import Data.Bits import Data.Either (isRight) import Data.Foldable (toList) @@ -110,6 +112,18 @@ import Swarm.Version (NewReleaseFailure (..)) import System.Clock import System.FilePath (splitDirectories) import Witch (into) +import Prelude hiding (Applicative (..)) -- See Note [liftA2 re-export from Prelude] + +-- ~~~~ Note [liftA2 re-export from Prelude] +-- +-- As of base-4.18 (GHC 9.6), liftA2 is re-exported from Prelude. See +-- https://github.com/haskell/core-libraries-committee/issues/50 . In +-- order to compile warning-free on both GHC 9.6 and older versions, +-- we hide the import of Applicative functions from Prelude and import +-- explicitly from Control.Applicative. In theory, if at some point +-- in the distant future we end up dropping support for GHC < 9.6 then +-- we could get rid of both explicit imports and just get liftA2 and +-- pure implicitly from Prelude. tutorialsDirname :: FilePath tutorialsDirname = "Tutorials" @@ -767,7 +781,7 @@ updateUI = do -- Whether the focused robot is too far away to sense, & whether -- that has recently changed dist <- use (gameState . to focusedRange) - farOK <- liftM2 (||) (use (gameState . creativeMode)) (use (gameState . worldScrollable)) + farOK <- liftA2 (||) (use (gameState . creativeMode)) (use (gameState . worldScrollable)) let tooFar = not farOK && dist == Just Far farChanged = tooFar /= isNothing listRobotHash diff --git a/src/Swarm/TUI/Launch/Controller.hs b/src/Swarm/TUI/Launch/Controller.hs index 2f3c533d..5136c261 100644 --- a/src/Swarm/TUI/Launch/Controller.hs +++ b/src/Swarm/TUI/Launch/Controller.hs @@ -10,7 +10,8 @@ import Brick.Widgets.Edit (handleEditorEvent) import Brick.Widgets.FileBrowser import Brick.Widgets.FileBrowser qualified as FB import Control.Lens -import Control.Monad.Except (forM_, liftIO, when) +import Control.Monad (forM_, when) +import Control.Monad.IO.Class (liftIO) import Data.Maybe (listToMaybe) import Graphics.Vty qualified as V import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (LaunchParams)) diff --git a/src/Swarm/TUI/Model.hs b/src/Swarm/TUI/Model.hs index d0def565..65cd7fbd 100644 --- a/src/Swarm/TUI/Model.hs +++ b/src/Swarm/TUI/Model.hs @@ -119,8 +119,10 @@ module Swarm.TUI.Model ( import Brick import Brick.Widgets.List qualified as BL import Control.Lens hiding (from, (<.>)) -import Control.Monad.Except -import Control.Monad.State +import Control.Monad ((>=>)) +import Control.Monad.Except (ExceptT (..), MonadError (catchError), withExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.State (MonadState) import Data.Array (Array, listArray) import Data.List (findIndex) import Data.List.NonEmpty (NonEmpty (..)) @@ -339,7 +341,7 @@ focusedEntity = -- | Given the focused robot, populate the UI inventory list in the info -- panel with information about its inventory. -populateInventoryList :: MonadState UIState m => Maybe Robot -> m () +populateInventoryList :: (MonadState UIState m) => Maybe Robot -> m () populateInventoryList Nothing = uiInventory .= Nothing populateInventoryList (Just r) = do mList <- preuse (uiInventory . _Just . _2) diff --git a/src/Swarm/TUI/Model/Repl.hs b/src/Swarm/TUI/Model/Repl.hs index 578f3207..d1ebfebc 100644 --- a/src/Swarm/TUI/Model/Repl.hs +++ b/src/Swarm/TUI/Model/Repl.hs @@ -65,6 +65,7 @@ import Servant.Docs qualified as SD import Swarm.Language.Types import Swarm.TUI.Model.Name import Swarm.Util.Lens (makeLensesNoSigs) +import Prelude hiding (Applicative (..)) ------------------------------------------------------------ -- REPL History diff --git a/src/Swarm/TUI/Model/StateUpdate.hs b/src/Swarm/TUI/Model/StateUpdate.hs index 228a5372..56a69f45 100644 --- a/src/Swarm/TUI/Model/StateUpdate.hs +++ b/src/Swarm/TUI/Model/StateUpdate.hs @@ -19,8 +19,10 @@ import Brick.AttrMap (applyAttrMappings) import Brick.Widgets.List qualified as BL import Control.Applicative ((<|>)) import Control.Lens hiding (from, (<.>)) -import Control.Monad.Except -import Control.Monad.State +import Control.Monad (guard, void) +import Control.Monad.Except (ExceptT, runExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.State (MonadState, execStateT) import Data.List qualified as List import Data.Map qualified as M import Data.Maybe (fromMaybe, isJust) diff --git a/src/Swarm/TUI/Model/UI.hs b/src/Swarm/TUI/Model/UI.hs index ff046196..5aedef16 100644 --- a/src/Swarm/TUI/Model/UI.hs +++ b/src/Swarm/TUI/Model/UI.hs @@ -59,7 +59,8 @@ import Brick.Focus import Brick.Widgets.List qualified as BL import Control.Arrow ((&&&)) import Control.Lens hiding (from, (<.>)) -import Control.Monad.Except +import Control.Monad.Except (ExceptT, withExceptT) +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Bits (FiniteBits (finiteBitSize)) import Data.Map (Map) import Data.Map qualified as M diff --git a/swarm.cabal b/swarm.cabal index 6ea852ef..01796403 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -18,7 +18,7 @@ maintainer: byorgey@gmail.com bug-reports: https://github.com/swarm-game/swarm/issues copyright: Brent Yorgey 2021 category: Game -tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.5 +tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.5 || ==9.6.2 extra-source-files: CHANGELOG.md example/*.sw editors/emacs/*.el @@ -187,7 +187,7 @@ library other-modules: Paths_swarm autogen-modules: Paths_swarm - build-depends: base >= 4.14 && < 4.18, + build-depends: base >= 4.14 && < 4.19, brick-list-skip >= 0.1.1.2 && < 0.2, aeson >= 2 && < 2.2, array >= 0.5.4 && < 0.6, @@ -216,25 +216,25 @@ library lens >= 4.19 && < 5.3, linear >= 1.21.6 && < 1.23, lsp >= 1.6 && < 1.7, - megaparsec >= 9.0 && < 9.4, + megaparsec >= 9.0 && < 9.5, minimorph >= 0.3 && < 0.4, transformers >= 0.5 && < 0.7, - mtl >= 2.2.2 && < 2.3, + mtl >= 2.2.2 && < 2.4, murmur3 >= 1.0.4 && < 1.1, natural-sort >= 0.1.2 && < 0.2, parser-combinators >= 1.2 && < 1.4, prettyprinter >= 1.7.0 && < 1.8, random >= 1.2.0 && < 1.3, - servant >= 0.19 && < 0.20, - servant-docs >= 0.12 && < 0.13, - servant-server >= 0.19 && < 0.20, + servant >= 0.19 && < 0.21, + servant-docs >= 0.12 && < 0.14, + servant-server >= 0.19 && < 0.21, SHA >= 1.6.4 && < 1.6.5, simple-enumeration >= 0.2 && < 0.3, split >= 0.2.3 && < 0.3, stm >= 2.5.0 && < 2.6, syb >= 0.7 && < 0.8, tagged >= 0.8 && < 0.9, - template-haskell >= 2.16 && < 2.20, + template-haskell >= 2.16 && < 2.21, text >= 1.2.4 && < 2.1, text-rope >= 0.2 && < 0.3, text-zipper >= 0.10 && < 0.14, @@ -259,7 +259,7 @@ library executable swarm import: stan-config, common main-is: Main.hs - build-depends: optparse-applicative >= 0.16 && < 0.18, + build-depends: optparse-applicative >= 0.16 && < 0.19, githash >= 0.1.6 && < 0.2, -- Imports shared with the library don't need bounds base, diff --git a/test/unit/TestUtil.hs b/test/unit/TestUtil.hs index 622686a8..b88a4e93 100644 --- a/test/unit/TestUtil.hs +++ b/test/unit/TestUtil.hs @@ -8,8 +8,9 @@ module TestUtil where import Control.Lens (Ixed (ix), to, use, (&), (.~), (^.), (^?)) -import Control.Monad.Except -import Control.Monad.State +import Control.Monad (void) +import Control.Monad.State (StateT (..), execState) +import Control.Monad.Trans (lift) import Data.Text (Text) import Data.Text qualified as T import Swarm.Game.CESK