twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-05-19 08:30:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #346 from liskin/ghc92

Browse Source 
Test against GHC 9.2.1; fix new warnings
This commit is contained in:
Tomáš Janoušek 2021-11-04 11:05:14 +00:00 committed by GitHub
commit a902fefaf1
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 102 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
.github/workflows/haskell-ci.yml vendored
View File

@ -8,9 +8,9 @@
# #
# For more information, see https://github.com/haskell-CI/haskell-ci # For more information, see https://github.com/haskell-CI/haskell-ci
# #
# version: 0.12 # version: 0.13.20211030
# #
# REGENDATA ("0.12",["github","cabal.project"]) # REGENDATA ("0.13.20211030",["github","cabal.project"])
# #
name: Haskell-CI name: Haskell-CI
on: on:
@ -35,50 +35,96 @@ jobs:
strategy: strategy:
matrix: matrix:
include: include:
- compiler: ghc-9.2.1
compilerKind: ghc
compilerVersion: 9.2.1
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.0.1 - compiler: ghc-9.0.1
compilerKind: ghc
compilerVersion: 9.0.1
setup-method: hvr-ppa
allow-failure: false allow-failure: false
upload: true upload: true
- compiler: ghc-8.10.4 - compiler: ghc-8.10.4
compilerKind: ghc
compilerVersion: 8.10.4
setup-method: hvr-ppa
allow-failure: false allow-failure: false
- compiler: ghc-8.8.4 - compiler: ghc-8.8.4
compilerKind: ghc
compilerVersion: 8.8.4
setup-method: hvr-ppa
allow-failure: false allow-failure: false
- compiler: ghc-8.6.5 - compiler: ghc-8.6.5
compilerKind: ghc
compilerVersion: 8.6.5
setup-method: hvr-ppa
allow-failure: false allow-failure: false
- compiler: ghc-8.4.4 - compiler: ghc-8.4.4
compilerKind: ghc
compilerVersion: 8.4.4
setup-method: hvr-ppa
allow-failure: false allow-failure: false
fail-fast: false fail-fast: false
steps: steps:
- name: apt - name: apt
run: | run: |
apt-get update apt-get update
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
apt-add-repository -y 'ppa:hvr/ghc' if [ "${{ matrix.setup-method }}" = ghcup ]; then
apt-get update mkdir -p "$HOME/.ghcup/bin"
apt-get install -y $CC cabal-install-3.4 libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
"$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
apt-get update
apt-get install -y libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
else
apt-add-repository -y 'ppa:hvr/ghc'
apt-get update
apt-get install -y "$HCNAME" libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
mkdir -p "$HOME/.ghcup/bin"
curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
"$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
fi
env: env:
CC: ${{ matrix.compiler }} HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: Set PATH and environment variables - name: Set PATH and environment variables
run: | run: |
echo "$HOME/.cabal/bin" >> $GITHUB_PATH echo "$HOME/.cabal/bin" >> $GITHUB_PATH
echo "LANG=C.UTF-8" >> $GITHUB_ENV echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
HCDIR=$(echo "/opt/$CC" | sed 's/-/\//') HCDIR=/opt/$HCKIND/$HCVER
HCNAME=ghc if [ "${{ matrix.setup-method }}" = ghcup ]; then
HC=$HCDIR/bin/$HCNAME HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
echo "HC=$HC" >> $GITHUB_ENV echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
else
HC=$HCDIR/bin/$HCKIND
echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
fi
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 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 "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
echo "HEADHACKAGE=false" >> $GITHUB_ENV echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
echo "GHCJSARITH=0" >> $GITHUB_ENV echo "GHCJSARITH=0" >> "$GITHUB_ENV"
env: env:
CC: ${{ matrix.compiler }} HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: env - name: env
run: | run: |
env env
@ -139,7 +185,8 @@ jobs:
- name: generate cabal.project - name: generate cabal.project
run: | run: |
PKGDIR_xmonad="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-[0-9.]*')" PKGDIR_xmonad="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-[0-9.]*')"
echo "PKGDIR_xmonad=${PKGDIR_xmonad}" >> $GITHUB_ENV echo "PKGDIR_xmonad=${PKGDIR_xmonad}" >> "$GITHUB_ENV"
rm -f cabal.project cabal.project.local
touch cabal.project touch cabal.project
touch cabal.project.local touch cabal.project.local
echo "packages: ${PKGDIR_xmonad}" >> cabal.project echo "packages: ${PKGDIR_xmonad}" >> cabal.project

12
src/XMonad/Core.hs
View File

@ -156,18 +156,13 @@ newtype ScreenDetail = SD { screenRect :: Rectangle }
-- instantiated on 'XConf' and 'XState' automatically. -- instantiated on 'XConf' and 'XState' automatically.
-- --
newtype X a = X (ReaderT XConf (StateT XState IO) a) newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (Functor, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf) deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
instance Applicative X where
pure = return
(<*>) = ap
instance Semigroup a => Semigroup (X a) where instance Semigroup a => Semigroup (X a) where
(<>) = liftM2 (<>) (<>) = liftM2 (<>)
instance (Monoid a) => Monoid (X a) where instance (Monoid a) => Monoid (X a) where
mempty = return mempty mempty = pure mempty
mappend = liftM2 mappend
instance Default a => Default (X a) where instance Default a => Default (X a) where
def = return def def = return def
@ -183,8 +178,7 @@ instance Semigroup a => Semigroup (Query a) where
(<>) = liftM2 (<>) (<>) = liftM2 (<>)
instance Monoid a => Monoid (Query a) where instance Monoid a => Monoid (Query a) where
mempty = return mempty mempty = pure mempty
mappend = liftM2 mappend
instance Default a => Default (Query a) where instance Default a => Default (Query a) where
def = return def def = return def

6
src/XMonad/Main.hs
View File

@ -193,12 +193,12 @@ launch initxmc drs = do
xinesc <- getCleanedScreenInfo dpy xinesc <- getCleanedScreenInfo dpy
nbc <- do v <- initColor dpy $ normalBorderColor xmc nbc <- do v <- initColor dpy $ normalBorderColor xmc
~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def Just nbc_ <- initColor dpy $ normalBorderColor Default.def
return (fromMaybe nbc_ v) return (fromMaybe nbc_ v)
fbc <- do v <- initColor dpy $ focusedBorderColor xmc fbc <- do v <- initColor dpy $ focusedBorderColor xmc
~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.def Just fbc_ <- initColor dpy $ focusedBorderColor Default.def
return (fromMaybe fbc_ v) return (fromMaybe fbc_ v)
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering

21
src/XMonad/Operations.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, LambdaCase #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Operations -- Module : XMonad.Operations
@ -341,15 +341,16 @@ getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo
-- | The screen configuration may have changed (due to -- xrandr), -- | The screen configuration may have changed (due to -- xrandr),
-- update the state and refresh the screen, and reset the gap. -- update the state and refresh the screen, and reset the gap.
rescreen :: X () rescreen :: X ()
rescreen = do rescreen = withDisplay getCleanedScreenInfo >>= \case
xinesc <- withDisplay getCleanedScreenInfo [] -> trace "getCleanedScreenInfo returned []"
xinesc:xinescs ->
windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->
let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)
(a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc a = W.Screen (W.workspace v) 0 (SD xinesc)
in ws { W.current = a as = zipWith3 W.Screen xs [1..] $ map SD xinescs
, W.visible = as in ws { W.current = a
, W.hidden = ys } , W.visible = as
, W.hidden = ys }
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------

21
src/XMonad/StackSet.hs
View File

@ -58,6 +58,8 @@ import Data.Foldable (foldr, toList)
import Data.Maybe (listToMaybe,isJust,fromMaybe) import Data.Maybe (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub) import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
import Data.List ( (\\) ) import Data.List ( (\\) )
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.Map as M (Map,insert,delete,empty) import qualified Data.Map as M (Map,insert,delete,empty)
-- $intro -- $intro
@ -208,10 +210,11 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
-- --
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
new l wids m | not (null wids) && length m <= length wids && not (null m) new l (wid:wids) (m:ms) | length ms <= length wids
= StackSet cur visi unseen M.empty = StackSet cur visi (map ws unseen) M.empty
where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids where ws i = Workspace i l Nothing
(cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ] (seen, unseen) = L.splitAt (length ms) wids
cur:visi = Screen (ws wid) 0 m : [ Screen (ws i) s sd | (i, s, sd) <- zip3 seen [1..] ms ]
-- now zip up visibles with their screen id -- now zip up visibles with their screen id
new _ _ _ = abort "non-positive argument to StackSet.new" new _ _ _ = abort "non-positive argument to StackSet.new"
@ -366,7 +369,7 @@ swapDown = modify' (reverseStack . swapUp' . reverseStack)
-- 'Stack' rather than an entire 'StackSet'. -- 'Stack' rather than an entire 'StackSet'.
focusUp', focusDown' :: Stack a -> Stack a focusUp', focusDown' :: Stack a -> Stack a
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs) focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs) focusUp' (Stack t [] rs) = Stack x xs [] where (x :| xs) = NE.reverse (t :| rs)
focusDown' = reverseStack . focusUp' . reverseStack focusDown' = reverseStack . focusUp' . reverseStack
swapUp' :: Stack a -> Stack a swapUp' :: Stack a -> Stack a
@ -522,8 +525,8 @@ sink w s = s { floating = M.delete w (floating s) }
-- Focus stays with the item moved. -- Focus stays with the item moved.
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster = modify' $ \c -> case c of swapMaster = modify' $ \c -> case c of
Stack _ [] _ -> c -- already master. Stack _ [] _ -> c -- already master.
Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls Stack t (l:ls) rs -> Stack t [] (xs ++ x : rs) where (x :| xs) = NE.reverse (l :| ls)
-- natural! keep focus, move current to the top, move top to current. -- natural! keep focus, move current to the top, move top to current.
@ -539,8 +542,8 @@ shiftMaster = modify' $ \c -> case c of
-- | /O(s)/. Set focus to the master window. -- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = modify' $ \c -> case c of focusMaster = modify' $ \c -> case c of
Stack _ [] _ -> c Stack _ [] _ -> c
Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls Stack t (l:ls) rs -> Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls)
-- --
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------

2
xmonad.cabal
View File

@ -27,7 +27,7 @@ author: Spencer Janssen, Don Stewart, Adam Vogt, David Roundy, Jason
Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver, Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver,
Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion
maintainer: xmonad@haskell.org maintainer: xmonad@haskell.org
tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1 tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1 || == 9.2.1
category: System category: System
homepage: http://xmonad.org homepage: http://xmonad.org
bug-reports: https://github.com/xmonad/xmonad/issues bug-reports: https://github.com/xmonad/xmonad/issues