mirror of
https://github.com/swarm-game/swarm.git
synced 2024-08-17 02:20:31 +03:00
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 <commits@restyled.io>
This commit is contained in:
parent
7daa64b9c3
commit
7f53d9061d
67
.github/workflows/haskell-ci.yml
vendored
67
.github/workflows/haskell-ci.yml
vendored
@ -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
|
||||
|
10
.mergify.yml
10
.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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
-- ---------
|
||||
|
@ -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 <> ":"
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -21,7 +21,7 @@
|
||||
-- See <https://github.com/swarm-game/swarm/issues/495>.
|
||||
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.
|
||||
--
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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))
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
18
swarm.cabal
18
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,
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user