xmonad-extras 0.12 → 0.12.1

raw patch · 8 files changed

+315/−165 lines, 8 filesdep ~HListdep ~hintPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HList, hint

API changes (from Hackage documentation)

Files

• XMonad/Actions/Volume.hs +5/−0
• XMonad/Config/Alt/Desktop.hs +18/−4
• XMonad/Config/Alt/Internal.hs +215/−123
• XMonad/Config/Alt/QQ.hs +35/−5
• XMonad/Config/Alt/Sample.hs +0/−25
• XMonad/Config/Alt/Sample1.hs +34/−0
• XMonad/Config/Alt/Types.hs +2/−2
• xmonad-extras.cabal +6/−6

@@ -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

@@ -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+

@@ -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 <vogt.adam@gmail.com> 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 |]

@@ -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 [] = []+

@@ -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'

@@ -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'+++

@@ -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) 

@@ -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