diff --git a/XMonad/Actions/Volume.hs b/XMonad/Actions/Volume.hs --- a/XMonad/Actions/Volume.hs +++ b/XMonad/Actions/Volume.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- boilerplate {{{ ---------------------------------------------------------------------------- -- | @@ -60,6 +61,10 @@ import System.Process import Text.ParserCombinators.Parsec import XMonad.Core + +#if MIN_VERSION_base(4,8,0) +import Prelude hiding ((<*)) +#endif infixl 1 <* (<*) :: Monad m => m a -> m b -> m a diff --git a/XMonad/Config/Alt/Desktop.hs b/XMonad/Config/Alt/Desktop.hs --- a/XMonad/Config/Alt/Desktop.hs +++ b/XMonad/Config/Alt/Desktop.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} @@ -27,6 +32,11 @@ avoidStrutsOn, avoidStruts, + + -- * precedences (apply modifiers in what should be the right order) + AvoidStrutsPrec, StatusBarPrec, + EwmhPrec, + ) where import qualified XMonad as X @@ -45,24 +55,27 @@ -- | See 'ManageDocks.avoidStrutsOn' avoidStrutsOn a c = ins' avoidStrutsPrec hTrue - (m Modify LayoutHook (ManageDocks.avoidStrutsOn a) =<<) + ((m (Proxy :: Proxy Modify) LayoutHook (ManageDocks.avoidStrutsOn a)) =<<) c + + -- | See 'ManageDocks.avoidStruts' avoidStruts c = ins' avoidStrutsPrec hTrue - (m Modify LayoutHook ManageDocks.avoidStruts =<<) + (m (Proxy :: Proxy Modify) LayoutHook ManageDocks.avoidStruts =<<) c -- | See 'DynamicLog.statusBar' -statusBar cmd pp k conf = avoidStruts . ins' statusBarPrec hTrue +-- doesn't set struts +statusBar cmd pp k conf = {- avoidStruts . -- doesn't typecheck -} + ins' statusBarPrec hTrue (\c -> do c' <- c c'' <- liftIO $ DynamicLog.statusBar cmd pp k c' return $ c'' { X.layoutHook = X.layoutHook c' } ) $ conf - toggleStrutsKey c = (X.modMask c, X.xK_b) xmobar conf = statusBar @@ -80,3 +93,4 @@ fg = "'#a8a3f7'" -- n.b quoting bg = "'#3f3c6d'" flags = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg + diff --git a/XMonad/Config/Alt/Internal.hs b/XMonad/Config/Alt/Internal.hs --- a/XMonad/Config/Alt/Internal.hs +++ b/XMonad/Config/Alt/Internal.hs @@ -1,6 +1,7 @@ {-# LANGUAGE - OverlappingInstances - ,EmptyDataDecls + EmptyDataDecls + ,ConstraintKinds + ,DataKinds ,FlexibleContexts ,FlexibleInstances ,FunctionalDependencies @@ -8,16 +9,16 @@ ,KindSignatures ,MultiParamTypeClasses ,NoMonomorphismRestriction + ,PolyKinds ,ScopedTypeVariables ,TemplateHaskell + ,TypeFamilies ,TypeOperators ,TypeSynonymInstances ,UndecidableInstances ,ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fcontext-stack=81 #-} --- I can't figure out an acceptable type for 'set' and similar: --- ghc doesn't accept the type inferred by ghci {- | @@ -27,7 +28,7 @@ Maintainer : Adam Vogt Stability : unstable -Portability : unportable +Portability : unportable (7.6 <= ghc <= 7.10) Import "XMonad.Config.Alt". -} @@ -45,11 +46,12 @@ modify, modifyIO, + -- ** less useful - modifyIO', insertInto, - -- * Things to modify + -- * Fields + -- $fields -- ** Special LayoutHook(LayoutHook), @@ -80,22 +82,17 @@ ins, -- ** Useful functions - HCompose(hComp), - Snd(Snd), - HSubtract(hSubtract), - HReplicateF(hReplicateF), - HPred'(hPred'), + HCompose(hComp_), hComp, + HSnd(HSnd), + HPred', -- ** For overloading Mode(..), - Add(Add), - Set(Set), - Modify(Modify), - ModifyIO(ModifyIO), + ModeAction(..), Config(..), - test, +-- test, module Data.HList, ) where @@ -109,16 +106,29 @@ import XMonad.Config.Alt.Types import XMonad.Config.Alt.QQ --- * Class to write set / modify as functions -class Mode action field e x y | action field e x -> y, action field x y -> e where - m :: action -> field -> e -> X.XConfig x -> Config (X.XConfig y) +{- | Class whose instances are used for 'add' 'set' 'modify' of an 'X.XConfig'@ layout@, which +can change the layout type. If we had lenses or other straightforward ways to adjust the entries +of 'X.XConfig', this class might be unnecessary. Without it, you would have to manually write out +things like: --- * Actions for 'Mode' -data Add = Add -- ^ the 'Mode' instance combines the old value like @new `mappend` old@ -data Set = Set -data Modify = Modify -data ModifyIO = ModifyIO +> ins' defaultPrec hFalse (liftM (\c -> c{ layoutHook = avoidStruts (layoutHook c) })) +instead of + +> modify LayoutHook avoidStruts + +-} +class Mode (action :: ModeAction) field e x y + | action field e x -> y, + action field x y -> e + -- action field e y -> x + where + m :: Proxy action -> field x y -> e -> X.XConfig x -> Config (X.XConfig y) + +-- | The data type for the first argument of a 'Mode' instance. +data ModeAction = Add -- ^ combines the old value like @new `mappend` old@ + | Set | Modify | ModifyIO + $(decNat "defaultPrec" 4) {- $actions @@ -131,24 +141,25 @@ * @action@ is an instance of 'Mode' so you only need to write 'ModifyIO' to describe how to access this field. - * @hold@ is 'HTrue' if you don't want to overwrite a preexisting value at the same @prec@. This is for things that should be applied once-only. + * @hold@ is @proxy :: Proxy True@ if you don't want to overwrite a preexisting value at the same @prec@. This is for things that should be applied once-only. * @field@ used with the 'Mode' * @v@ the value that is being updated (or a function if you use 'Modify' or similar) -} -set f v = insertInto Set hFalse defaultPrec f v -add f v = insertInto Add hFalse defaultPrec f v -modify f v = insertInto Modify hFalse defaultPrec f v -modifyIO = modifyIO' hFalse defaultPrec -modifyIO' x = insertInto ModifyIO x +set f v = insertInto defaultPrec hFalse (Proxy :: Proxy Set) f v +add f v = insertInto defaultPrec hFalse (Proxy :: Proxy Add) f v +modify f v = insertInto defaultPrec hFalse (Proxy :: Proxy Modify) f v +modifyIO f v = insertInto defaultPrec hFalse (Proxy :: Proxy ModifyIO) f v -insertInto action hold prec f x = ins' prec hold (m action f x =<<) +insertInto prec hold action field e l = ins' prec hold (m action field e =<<) l + + -- | Represent setting layouts and layout modifiers -data LayoutHook = LayoutHook +data LayoutHook x y = LayoutHook instance Mode ModifyIO LayoutHook (l X.Window -> Config (m X.Window)) l m where @@ -158,17 +169,17 @@ -- | 'Add' means something else for 'X.layoutHook' because there's no suitable -- mempty for the general instance of 'X.LayoutClass' -instance (X.LayoutClass l X.Window, X.LayoutClass l' X.Window) => - Mode Add LayoutHook (l' X.Window) l (X.Choose l' l) where +instance (X.LayoutClass l w, X.LayoutClass l' w, w ~ X.Window) => + Mode Add LayoutHook (l' w) l (X.Choose l' l) where m _ _ l = \x -> return $ x { X.layoutHook = l X.||| X.layoutHook x } -instance (Read (l X.Window), X.LayoutClass l X.Window, - Read (l' X.Window), X.LayoutClass l' X.Window) => - Mode Modify LayoutHook (l X.Window -> l' X.Window) l l' where +instance (w ~ X.Window, Read (l w), X.LayoutClass l w, + Read (l' w), X.LayoutClass l' w) => + Mode Modify LayoutHook (l w -> l' w) l l' where m _ _ l = \x -> return $ x { X.layoutHook = l (X.layoutHook x) } -instance (X.LayoutClass l' X.Window) => - Mode Set LayoutHook (l' X.Window) l l' where +instance (X.LayoutClass l' w, w ~ X.Window) => + Mode Set LayoutHook (l' w) l l' where m _ _ l = \x -> return $ x { X.layoutHook = l } @@ -176,119 +187,197 @@ -data Snd = Snd -instance Apply Snd (a, b) b where - apply _ (_, b) = b +data HSnd = HSnd +instance ab ~ (a,b) => ApplyAB HSnd ab b where + applyAB _ (_, b) = b +data Id = Id deriving Show --- | like @foldr (.) id@, but for a heteregenous list. -class HCompose l f | l -> f where - hComp :: l -> f -instance HCompose HNil (a -> a) where - hComp _ = id +-- | The difference between HNats. Clamped to HZero +type family HSubtract (a :: HNat) (b :: HNat) :: HNat +type instance HSubtract (HSucc a) (HSucc b) = HSubtract a b +type instance HSubtract a HZero = a +type instance HSubtract HZero b = HZero -instance HCompose r (a -> b) => HCompose ((b -> c) :*: r) (a -> c) where - hComp (HCons g r) = g . hComp r +hSubtract :: Proxy a -> Proxy b -> Proxy (HSubtract a b) +hSubtract _ _ = undefined +type family MergeEither (x :: Either HNat HNat) :: HNat +type instance MergeEither (Left n) = HZero +type instance MergeEither (Right n) = n --- | The difference between HNats. Clamped to HZero -class HSubtract a b c | a b -> c where - hSubtract :: a -> b -> c -instance (HNat a, HNat b, HSubtract a b c) => HSubtract (HSucc a) (HSucc b) c where - hSubtract a b = hSubtract (hPred a) (hPred b) -instance HNat a => HSubtract a HZero a where - hSubtract a _ = a +-- | exactly like hPred, but accept HZero too +type family HPred' (n :: HNat) :: HNat +type instance HPred' (HSucc n) = n +type instance HPred' HZero = HZero -instance HSubtract HZero b HZero where - hSubtract _ _ = hZero +insLt n hold f l = + l + `hAppendList` + (hReplicate (n `hSubtract` hLength l) (hFalse, Id)) + `hAppendList` + ((hold,f) `HCons` HNil) -class HNat n => HReplicateF n e l | n e -> l where - hReplicateF :: n -> e -> l +-- | to avoid ambiguous types, we use data Id instead of just id, +-- and then instead of (.) we have to use this Compose class +class Compose f g fog | f g -> fog where + compose :: f -> g -> fog -instance HReplicateF HZero e HNil where - hReplicateF _ _ = HNil +instance (b ~ b') => Compose (b -> c) (a -> b') (a -> c) where + compose = (.) -instance (Apply e x y, HReplicateF n e r) => HReplicateF (HSucc n) e ((HFalse, x -> y) :*: r) where - hReplicateF n e = (hFalse, apply e) `HCons` hReplicateF (hPred n) e +instance Compose (a -> b) Id (a -> b) where + compose f _ = f +instance Compose Id (a -> b) (a -> b) where + compose _ f = f +instance Compose Id Id Id where + compose _ f = f --- | exactly like hPred, but accept HZero too -class HPred' n n' | n -> n' where - hPred' :: n -> n' +instance (RunComposeIf b f g w, + Compose w x y) => Compose (ComposeIf b f g) x y where + compose bfg x = runComposeIf bfg `compose` x -instance HPred' HZero HZero where - hPred' _ = hZero +instance (RunComposeIf b f g x, + Compose w x y) => Compose w (ComposeIf b f g) y where + compose w bfg = w `compose` runComposeIf bfg -instance HNat n => HPred' (HSucc n) n where - hPred' = hPred +instance (RunComposeIf b f g x, + RunComposeIf b' f' g' w, + Compose w x y) => Compose (ComposeIf b' f' g') (ComposeIf b f g) y where + compose bfg' bfg = runComposeIf bfg' `compose` runComposeIf bfg -insLt n hold f l = - l - `hAppend` - (hReplicateF ({-hPred' $ -} n `hSubtract` hLength l) Id) - `hAppend` - ((hold,f) `HCons` HNil) +class RunComposeIf b f g fg | b f g -> fg where + runComposeIf :: ComposeIf b f g -> fg + +instance Compose f g fg => RunComposeIf True f g fg where + runComposeIf (ComposeIf f g) = compose f g + +instance RunComposeIf False f g g where + runComposeIf (ComposeIf _ g) = g + +data ComposeIf (b :: Bool) f g = ComposeIf f g + +composeIf :: Proxy b -> f -> g -> ComposeIf b f g +composeIf _ = ComposeIf + insGeq n a f l = let (b,g) = hLookupByHNat n l - h = hCond b (b,g) (a,f . g) + h = (hOr b a, composeIf (hNot b) f g) in hUpdateAtHNat n h l +hNot :: Proxy b -> Proxy (HNot b) +hNot _ = Proxy + + -- | utility class, so that we can use contexts that may not be satisfied, -- depending on the length of the accumulated list. -class (HBool hold) => Ins2 b n hold f l l' | b n hold f l -> l' where - ins2 :: b -> n -> hold -> f -> l -> l' +class Ins2 (b :: Bool) (n :: HNat) (hold :: Bool) f l l' + | b n hold f l -> l' + ,b n hold f l' -> l + ,b hold l l' -> f + where + ins2 :: Proxy b -> Proxy n -> Proxy hold -> f -> HList l -> HList l' -- | when l needs to be padded with id -instance - (-- HPred' a n', - HLength l n, - HSubtract a1 n a, - -- HReplicateF n' Id l', - HReplicateF a Id l', - HAppend l l' l'', - HAppend l'' (HCons (hold,e) HNil) l''1, - HBool hold) => - Ins2 HTrue a1 hold e l l''1 - where ins2 _ = insLt +instance + (HAppendList (HAppendListR l1 ids) '[(Proxy hold, t1)], + l2 ~ HAppendListR (HAppendListR l1 ids) '[(Proxy hold, t1)], + HAppendList l1 ids, + HLengthEq l1 b, + HReplicateFD (HSubtract n b) id ids, + id ~ (Proxy 'False, Id)) => + Ins2 True n hold t1 l1 l2 + where ins2 _ = insLt --- | when l already has enough elements, just compose. Only when the existing HBool is HFalse -instance - (HLookupByHNat n l (t, a -> b), - HUpdateAtHNat n z l l', - HCond t (t, a -> b) (t1, a -> c) z, - HBool t1) => - Ins2 HFalse n t1 (b -> c) l l' +-- | when l already has enough elements, just compose. But only add the new +-- function when the existing HBool is HFalse +instance (HUpdateAtHNat n e l, HLookupByHNat n l, + (Proxy (HOr t t1), ComposeIf (HNot t) bc ab) ~ e, + HLookupByHNatR n l ~ (Proxy t, ab), + HLookupByHNatR n l' ~ e, + HUpdateAtHNatR n e l ~ l') => + Ins2 False n t1 bc l l' where ins2 _ = insGeq -class Ins' n hold f l l' | n hold f l -> l' where - ins' :: n -> hold -> f -> l -> l' +class Ins' (n :: HNat) (hold :: Bool) f l l' | n hold f l -> l' + where + ins' :: Proxy n -> Proxy hold -> f -> HList l -> HList l' -instance (HLength l ll, HLt ll n b, Ins2 b n hold f l l') => Ins' n hold f l l' where - ins' = ins2 (undefined :: b) +instance ( HLt (HLength l) n ~ b, Ins2 (HLt (HLength l) n) n hold f l l') => Ins' n hold f l l' where + ins' = ins2 (undefined :: Proxy b) +-- ins' prec hold f l = ins2 ( hLt (hLength l) prec ) prec hold f l + {- | @ins n f xs@ inserts at index @n@ the function f, or extends the list @xs@ with 'id' if there are too few elements. This way the precedence is not bounded. -} ins n e = ins' n hFalse (e =<<) +{- | like @foldr (.) id@, but for a heteregenous list. This does the other + order than hComposeList. To avoid ambiguous types (and allow the FD to be accepted + by ghc-7.8) 'Id' is produced instead of 'id'. + + >>> hComposeList ((+1) .*. (*2) .*. HNil) 2 + 6 + + >>> hComp ((+1) .*. (*2) .*. HNil) 2 + 5 +-} +class HCompose l f | l -> f where + hComp_ :: HList l -> f + +instance HCompose '[] Id where + hComp_ _ = Id + +instance (Compose bc ab ac, HCompose rs ab) => HCompose (bc ': rs) ac where + hComp_ (HCons g r) = g `compose` hComp_ r + +{- | handles the empty list case: + +>>> hComp HNil () +() + +>>> hComp_ HNil +Id + + +-} +hComp fs x = (hComp_ fs `compose` (\y -> y `asTypeOf` x)) x + + +hMapSnd :: (HMapCxt HList HSnd x y, + HMapSndR x ~ y) => HList x -> HList y +hMapSnd = hMap HSnd + +-- | without this ghc cannot infer the result type of hMapSnd +type family HMapSndR (xs :: [*]) :: [*] +type instance HMapSndR ((a,b) ': xs) = b ': HMapSndR xs +type instance HMapSndR '[] = '[] + + + runConfig' defConfig x = do - let Config c = hComp (hMap Snd (hComp (hEnd x) HNil)) (return defConfig) + let returnConfig = return :: a -> Config a + Config c = hComp (hMapSnd (hComp x HNil)) + (returnConfig defConfig) + (a,w) <- runWriterT c print (w []) return a ---runConfig :: (X.LayoutClass l X.Window, Read (l X.Window)) => Config (X.XConfig l) -> IO () runConfig x = X.xmonad =<< runConfig' X.defaultConfig x -- * Tests +{- data T1 a = T1 a deriving Show data T2 a = T2 a deriving Show @@ -296,15 +385,17 @@ data T3a a = T3a a deriving Show data RunMWR = RunMWR -instance (Monad m, HCompose l (m () -> Writer w a)) => Apply RunMWR l (a, w) where - apply _ x = runWriter $ hComp x (return ()) -data Print = Print -instance Show a => Apply Print a (IO ()) where - apply _ = print +instance (Monad m, HCompose l (m () -> Writer w a)) => ApplyAB RunMWR (HList l) (a, w) where + -- type ApplyB RunMWR (HList l) = Just ... fundeps and AT's don't really mix + -- type ApplyA RunMWR (a,w ) = Nothing + applyAB _ x = runWriter $ hComp x (return ()) + -} +{- should be able to app (HMap (HMap f)) data HHMap a = HHMap a instance HMap f a b => Apply (HHMap f) a b where apply (HHMap f) = hMap f +-} {- | Verification that insertions happen in order @@ -313,21 +404,21 @@ > (T2 (T3 (T1 ())),"321") > (T2 (T3a (T3 (T1 ()))),"3221") --} +-- broken. Fixing probably involves nasty type signatures like for set get modify etc. test :: IO () -test = sequence_ $ hMapM Print $ hMap RunMWR $ hMap (HHMap Snd) $ hEnd $ hBuild +test = sequence_ $ hMapM (HPrint `HComp` RunMWR) $ applyA' (HMap (HMap HSnd)) $ hEnd $ hBuild test1_ test2_ test3_ test3a_ - where - test1_ = ins (undefined `asTypeOf` hSucc (hSucc (hSucc hZero))) (\x -> tell "3" >> return (T1 x)) hNil + where + test1_ = ins (undefined `asTypeOf` hSucc (hSucc (hSucc hZero))) (\x -> tell "3" >> return (T1 x)) HNil test2_ = ins (hSucc hZero) (\x -> tell "1" >> return (T2 x)) test1_ test3_ = ins (hSucc (hSucc hZero)) (\x -> tell "2" >> return (T3 x)) test2_ test3a_ = ins (hSucc (hSucc hZero)) (\x -> tell "2" >> return (T3a x)) test3_ - +-} -{- Generated instances for monomorphic fields in 'X.XConfig' +{- $fields Generated instances for monomorphic fields in 'X.XConfig' Follows the style of: @@ -376,7 +467,7 @@ let mkId action tyIn body = instanceD (return []) - [t| $(conT ''Mode) $(conT action) $(conT d) $(tyIn) $l $l |] + [t| $(conT ''Mode) $(promotedT action) $(conT d) $(tyIn) $l $l |] [funD 'm [clause [wildP,wildP] @@ -393,13 +484,14 @@ [funD 'm [clause [] (normalB [| error "impossible to satisfy" |]) [] ]] `const` act -- suppress unused var warning - sequence $ + xyTyVarBinders = [v "x", v "y"] + where v x = KindedTV (mkName x) (ArrowT `AppT` StarT `AppT` StarT) - [fallback (conT n) | n <- [''ModifyIO, ''Modify, ''Set] ] ++ + sequence $ - [dataD (return []) d [] [normalC d []] [] + [dataD (return []) d xyTyVarBinders [normalC d []] [] - ,mkId ''ModifyIO [t| $ty -> Config $ty |] + ,mkId 'ModifyIO [t| $ty -> Config $ty |] [| \f c -> do r <- f ($(varE acc) c) return $(recUpdE @@ -407,7 +499,7 @@ [fmap (\r' -> (acc,r')) [| r |]]) |] - ,mkId ''Modify [t| $ty -> $ty |] + ,mkId 'Modify [t| $ty -> $ty |] [| \f c -> do r <- return $ f ($(varE acc) c) return $(recUpdE @@ -415,7 +507,7 @@ [fmap (\r' -> (acc,r')) [| r |]]) |] - ,mkId ''Set [t| $ty |] + ,mkId 'Set [t| $ty |] [| \f c -> do return $(recUpdE [| c |] diff --git a/XMonad/Config/Alt/QQ.hs b/XMonad/Config/Alt/QQ.hs --- a/XMonad/Config/Alt/QQ.hs +++ b/XMonad/Config/Alt/QQ.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE TemplateHaskell #-} {- | Shorthand. The following are equivalent: @@ -8,18 +9,41 @@ > $(nat 2) +This is probably redundant given "GHC.TypeLits". But for now HList +uses it's own 'HNat'. + -} module XMonad.Config.Alt.QQ where import Language.Haskell.TH.Quote import Language.Haskell.TH -import Data.HList - +import Data.HList.CommonMain +import Data.Char +import Text.ParserCombinators.ReadP nat' :: QuasiQuoter nat' = QuasiQuoter { quoteExp = \n -> nat (read n), - quotePat = error "XMonad.Config.Alt.QQ.nat'.quotePat: unimplemented"} + quotePat = error "XMonad.Config.Alt.QQ.nat'.quotePat: unimplemented", + quoteType = \n -> natTy (read n), + quoteDec = \s -> case readP_to_S parseDecNat s of + [((v,n), "")] -> decNat v n + _ -> fail ("XMonad.Config.Alt.QQ.nat.quoteDec cannot parse " ++ show s) + } + +parseDecNat :: ReadP (String, Int) +parseDecNat = do + skipSpaces + v <- munch isAlpha + skipSpaces + char '=' + skipSpaces + n <- munch isNumber + skipSpaces + eof + return (v, read n) + + nat :: Int -> ExpQ nat n = foldr appE [| hZero |] (replicate n [| hSucc |]) @@ -29,5 +53,11 @@ decNat :: String -> Int -> Q [Dec] decNat t n = do d <- valD (varP (mkName t)) (normalB (nat n)) [] - s <- sigD (mkName t) (natTy n) - return [s,d] + let ty = [t| Proxy $(natTy n) |] + s <- sigD (mkName t) ty + abbrev <- tySynD (mkName (headToUpper t)) [] ty + return [s,d, abbrev] + +headToUpper (x:xs) = toUpper x : xs +headToUpper [] = [] + diff --git a/XMonad/Config/Alt/Sample.hs b/XMonad/Config/Alt/Sample.hs deleted file mode 100644 --- a/XMonad/Config/Alt/Sample.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# OPTIONS_GHC -fno-warn-missing-signatures -fcontext-stack=81 #-} -module XMonad.Config.Alt.Sample where -import XMonad.Config.Alt as C -import XMonad -import qualified XMonad.Hooks.ManageDocks -import qualified XMonad.Hooks.DynamicLog - --- for an unknown reason ex1 and ex2 cannot coexist with ghc-7.0.2, previously --- they did --- ex1, ex2 :: IO () --- ex1 = runConfig $ hBuild --- (C.modify Workspaces (++["lol","hi"])) --- (C.set ModMask mod4Mask) --- (C.modify LayoutHook XMonad.Hooks.ManageDocks.avoidStruts) - - -ex2 = runConfig ex2' - -ex2' = hEnd $ hBuild - (C.avoidStruts) - (C.statusBar "xmobar" XMonad.Hooks.DynamicLog.xmobarPP (\c -> (modMask c, xK_b))) - (C.set LayoutHook (Tall 2 0.5 0.02)) - -ex2'' = runConfig' defaultConfig ex2' diff --git a/XMonad/Config/Alt/Sample1.hs b/XMonad/Config/Alt/Sample1.hs new file mode 100644 --- /dev/null +++ b/XMonad/Config/Alt/Sample1.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures -fcontext-stack=81 #-} +module XMonad.Config.Alt.Sample1 where +import XMonad.Config.Alt as C +import XMonad +import qualified XMonad.Hooks.ManageDocks +import qualified XMonad.Hooks.DynamicLog + +ex1 = runConfig $ hBuild + (C.modify Workspaces (++["lol","hi"])) + (C.set ModMask mod4Mask) + (C.set LayoutHook Full) + (C.modify LayoutHook XMonad.Hooks.ManageDocks.avoidStruts) + +ex2 = runConfig ex2' + +ex2' = hEnd $ hBuild + (C.statusBar "xmobar" XMonad.Hooks.DynamicLog.xmobarPP (\c -> (modMask c, xK_b))) + (C.add LayoutHook Full) -- if this goes below the set, then you get + -- ex2'' :: IO (XConfig (ModifiedLayout AvoidStruts Tall)) + -- + -- instead of + -- + -- ex2'' :: IO (XConfig (ModifiedLayout AvoidStruts (Choose Full Tall)) + (C.set LayoutHook (Tall 2 0.5 0.02)) + (C.avoidStruts) -- doesn't matter where this one goes + (C.set LayoutHook (Tall 2 0.5 0.02)) + (C.set LayoutHook (Tall 2 0.5 0.02)) + +ex2'' = runConfig' defaultConfig ex2' + + + diff --git a/XMonad/Config/Alt/Types.hs b/XMonad/Config/Alt/Types.hs --- a/XMonad/Config/Alt/Types.hs +++ b/XMonad/Config/Alt/Types.hs @@ -4,7 +4,7 @@ module XMonad.Config.Alt.Types where import XMonad import Control.Monad.Writer - +import Control.Applicative -- TH stage restriction otherwise data Mode_ = Add_ | Modify_ | ModifyIO_ | Set_ @@ -12,5 +12,5 @@ type Warnings = [String] -> [String] newtype Config a = Config (WriterT Warnings IO a) - deriving (Monad, MonadIO, MonadWriter Warnings) + deriving (Monad, Applicative, Functor, MonadIO, MonadWriter Warnings) diff --git a/xmonad-extras.cabal b/xmonad-extras.cabal --- a/xmonad-extras.cabal +++ b/xmonad-extras.cabal @@ -1,5 +1,5 @@ name: xmonad-extras -version: 0.12 +version: 0.12.1 homepage: http://projects.haskell.org/xmonad-extras synopsis: Third party extensions for xmonad with wacky dependencies description: Various modules for xmonad that cannot be added to xmonad-contrib @@ -66,7 +66,7 @@ if impl(ghc < 7.2) build-depends: hint >= 0.3 && < 0.4, network else - build-depends: hint >= 0.3.3.3 && < 0.4, network + build-depends: hint >= 0.3.3.3 && < 0.5, network exposed-modules: XMonad.Actions.Eval XMonad.Prompt.Eval -- XMonad.Hooks.EvalServer @@ -78,17 +78,17 @@ build-depends: regex-posix exposed-modules: XMonad.Util.WindowPropertiesRE - if impl(ghc >= 6.12.1) && flag(with_template_haskell) && flag(with_hlist) - build-depends: template-haskell, HList >= 0.2.3 && < 0.3 + if flag(with_template_haskell) && flag(with_hlist) + build-depends: template-haskell, HList >= 0.4 && < 0.5 exposed-modules: XMonad.Config.Alt XMonad.Config.Alt.Desktop - XMonad.Config.Alt.Sample + XMonad.Config.Alt.Sample1 XMonad.Config.Alt.Internal XMonad.Config.Alt.QQ other-modules: XMonad.Config.Alt.Types - exposed-modules: XMonad.Hooks.PerWindowKbdLayout + exposed-modules: XMonad.Hooks.PerWindowKbdLayout if impl(ghc >= 6.12.1) ghc-options: -fno-warn-unused-do-bind