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
#
# version: 0.12
# version: 0.13.20211030
#
# REGENDATA ("0.12",["github","cabal.project"])
# REGENDATA ("0.13.20211030",["github","cabal.project"])
#
name: Haskell-CI
on:
@ -35,50 +35,96 @@ jobs:
strategy:
matrix:
include:
- compiler: ghc-9.2.1
compilerKind: ghc
compilerVersion: 9.2.1
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.0.1
compilerKind: ghc
compilerVersion: 9.0.1
setup-method: hvr-ppa
allow-failure: false
upload: true
- compiler: ghc-8.10.4
compilerKind: ghc
compilerVersion: 8.10.4
setup-method: hvr-ppa
allow-failure: false
- compiler: ghc-8.8.4
compilerKind: ghc
compilerVersion: 8.8.4
setup-method: hvr-ppa
allow-failure: false
- compiler: ghc-8.6.5
compilerKind: ghc
compilerVersion: 8.6.5
setup-method: hvr-ppa
allow-failure: false
- compiler: ghc-8.4.4
compilerKind: ghc
compilerVersion: 8.4.4
setup-method: hvr-ppa
allow-failure: false
fail-fast: false
steps:
- name: apt
run: |
apt-get update
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
apt-add-repository -y 'ppa:hvr/ghc'
apt-get update
apt-get install -y $CC cabal-install-3.4 libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
if [ "${{ matrix.setup-method }}" = ghcup ]; then
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 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:
CC: ${{ matrix.compiler }}
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: Set PATH and environment variables
run: |
echo "$HOME/.cabal/bin" >> $GITHUB_PATH
echo "LANG=C.UTF-8" >> $GITHUB_ENV
echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV
HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')
HCNAME=ghc
HC=$HCDIR/bin/$HCNAME
echo "HC=$HC" >> $GITHUB_ENV
echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV
echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV
echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
HCDIR=/opt/$HCKIND/$HCVER
if [ "${{ matrix.setup-method }}" = ghcup ]; then
HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
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"
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))')
echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
echo "HEADHACKAGE=false" >> $GITHUB_ENV
echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
echo "GHCJSARITH=0" >> $GITHUB_ENV
echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
echo "GHCJSARITH=0" >> "$GITHUB_ENV"
env:
CC: ${{ matrix.compiler }}
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: env
run: |
env
@ -139,7 +185,8 @@ jobs:
- name: generate cabal.project
run: |
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.local
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.
--
newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (Functor, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
instance Applicative X where
pure = return
(<*>) = ap
deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
instance Semigroup a => Semigroup (X a) where
(<>) = liftM2 (<>)
instance (Monoid a) => Monoid (X a) where
mempty = return mempty
mappend = liftM2 mappend
mempty = pure mempty
instance Default a => Default (X a) where
def = return def
@ -183,8 +178,7 @@ instance Semigroup a => Semigroup (Query a) where
(<>) = liftM2 (<>)
instance Monoid a => Monoid (Query a) where
mempty = return mempty
mappend = liftM2 mappend
mempty = pure mempty
instance Default a => Default (Query a) where
def = return def

6
src/XMonad/Main.hs
View File

@ -193,12 +193,12 @@ launch initxmc drs = do
xinesc <- getCleanedScreenInfo dpy
nbc <- do v <- initColor dpy $ normalBorderColor xmc
~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
nbc <- do v <- initColor dpy $ normalBorderColor xmc
Just nbc_ <- initColor dpy $ normalBorderColor Default.def
return (fromMaybe nbc_ v)
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)
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
@ -341,15 +341,16 @@ getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo
-- | The screen configuration may have changed (due to -- xrandr),
-- update the state and refresh the screen, and reset the gap.
rescreen :: X ()
rescreen = do
xinesc <- withDisplay getCleanedScreenInfo
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
(a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
in ws { W.current = a
, W.visible = as
, W.hidden = ys }
rescreen = withDisplay getCleanedScreenInfo >>= \case
[] -> trace "getCleanedScreenInfo returned []"
xinesc:xinescs ->
windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->
let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)
a = W.Screen (W.workspace v) 0 (SD xinesc)
as = zipWith3 W.Screen xs [1..] $ map SD xinescs
in ws { W.current = a
, 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 qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
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)
-- $intro
@ -208,10 +210,11 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
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)
= StackSet cur visi unseen M.empty
where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
(cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
new l (wid:wids) (m:ms) | length ms <= length wids
= StackSet cur visi (map ws unseen) M.empty
where ws i = Workspace i l Nothing
(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
new _ _ _ = abort "non-positive argument to StackSet.new"
@ -366,7 +369,7 @@ swapDown = modify' (reverseStack . swapUp' . reverseStack)
-- 'Stack' rather than an entire 'StackSet'.
focusUp', focusDown' :: Stack a -> Stack a
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
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.
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster = modify' $ \c -> case c of
Stack _ [] _ -> c -- already master.
Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
Stack _ [] _ -> c -- already master.
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.
@ -539,8 +542,8 @@ shiftMaster = modify' $ \c -> case c of
-- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = modify' $ \c -> case c of
Stack _ [] _ -> c
Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
Stack _ [] _ -> c
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,
Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion
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
homepage: http://xmonad.org
bug-reports: https://github.com/xmonad/xmonad/issues