1 files changed, 0 insertions, 326 deletions
diff --git a/src/Rahm/Desktop/Layout.hs b/src/Rahm/Desktop/Layout.hs
deleted file mode 100644
index 95854b8..0000000
--- a/src/Rahm/Desktop/Layout.hs
+++ /dev/null
@@ -1,326 +0,0 @@
-{-# LANGUAGE MultiParamTypeClasses, ViewPatterns, FlexibleInstances, KindSignatures, DataKinds, GADTs, RankNTypes, PolyKinds #-}
-module Rahm.Desktop.Layout where
-
-import GHC.TypeLits
-
-import Data.Proxy (Proxy(..))
-import Rahm.Desktop.CornerLayout (Corner(..))
-import Control.Arrow (second)
-import XMonad.Hooks.ManageDocks
-import XMonad.Layout.Circle
-import XMonad.Layout.Accordion
-import Control.Applicative
-import XMonad.Layout.Spacing
-import Data.List
-import XMonad.Layout.Spiral
-import XMonad.Layout.ThreeColumns
-import XMonad.Layout.Grid
-import XMonad.Layout.Dishes
-import XMonad.Layout.MosaicAlt
-import XMonad.Layout.Fullscreen
-import qualified XMonad.Layout.Dwindle as D
-import XMonad.Layout
-import XMonad.Layout.LayoutModifier
-import XMonad
-import XMonad.Core
-import XMonad.Layout.NoBorders (smartBorders, noBorders)
-
-import Rahm.Desktop.LayoutList
-import Rahm.Desktop.Windows
-
-import qualified Data.Map as M
-import qualified XMonad.StackSet as W
-
-myLayout =
-  fullscreenFull $
-    avoidStruts $
-      spacingRaw True (Border 5 5 5 5) True (Border 5 5 5 5) True $
-        layoutZipper $
-          mods (reinterpretIncMaster $ spiral (6/7)) |:
-          mods (modifyMosaic (MosaicAlt M.empty :: MosaicAlt Window)) |:
-          mods (reinterpretIncMaster $ Corner (3/4) (3/100)) |:
-          mods (ModifyDescription TallDescriptionModifier (Tall 1 (3/100) (1/2))) |:
-          mods (ModifyDescription ThreeColDescMod (ThreeCol 1 (3/100) (1/2))) |:
-          mods Grid |:
-          mods (Dishes 2 (1/6)) |:
-          mods (reinterpretIncMaster $ D.Dwindle D.R D.CW 1.5 1.1) |:
-          nil
-
--- This is a type class that defines how to reinterpret a message. One can think
--- of this as a kind of type-level function. It lets one associate a function
--- (reinterpretMessage) with a type construct, which for the case below is a
--- Symbol.
---
--- It would be nice to attach this function to the LayoutModifier directly as a
--- value, however LayoutModifiers must be Show-able and Read-able and functions
--- are not. However encoding in the typesystem itsef which function is to be
--- called is the best alternative I have.
-class DoReinterpret (k :: t) where
-  reinterpretMessage ::
-    Proxy k -> SomeMessage -> X (Maybe SomeMessage)
-
--- Mosaic doesn't have the concept of a "Master Space", so reinterpret messages
--- intended to modify the master space and instead have those messages expand
--- and shrink the current window.
---
--- "ForMosaic" is an instance of the Symbol kind. This is some neat type-system
--- hacking one can do in Haskell.
-instance DoReinterpret "ForMosaic" where
-  
-  -- IncMaster message
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) = do
-    fmap (SomeMessage .
-      (if n > 0
-        then expandWindowAlt
-        else shrinkWindowAlt)) <$> getFocusedWindow
-  
-  -- ResizeMaster message
-  reinterpretMessage _ (fromMessage -> Just m) = do
-    fmap (SomeMessage .
-      (case m of
-        Expand -> expandWindowAlt
-        Shrink -> shrinkWindowAlt)) <$> getFocusedWindow
-
-  -- Messages that don't match the above, just leave it unmodified.
-  reinterpretMessage _ m = return (Just m)
-
-instance DoReinterpret "IncMasterToResizeMaster" where
-  reinterpretMessage _ (fromMessage -> Just (IncMasterN n)) =
-    return $ Just $
-      if n > 0
-        then SomeMessage Expand
-        else SomeMessage Shrink
-  reinterpretMessage _ m = return (Just m)
-
--- Data construct for association a DoReinterpret function with a concrete
--- construct that can be used in the LayoutModifier instance.
---
--- It wolud be nice to have ReinterpretMessage hold the function as a value
--- rather than delegate to this kind-instance, however, it won't work because
--- LayoutModifiers have to be Read-able and Show-able, and functions are neither
--- of those, so a value-level function may not be a member of a LayoutModifier,
--- thus I have to settle for delegating to a hard-coded instance using
--- type-classes.
-data ReinterpretMessage k a = ReinterpretMessage
-  deriving (Show, Read)
-
--- Instance for ReinterpretMessage as a Layout modifier.
-instance (DoReinterpret k) =>
-      LayoutModifier (ReinterpretMessage k) a where 
-
-  handleMessOrMaybeModifyIt self message = do
-
-    -- Delegates to the reinterpretMessage function associatied with the
-    -- type-variable k.
-    newMessage <- reinterpretMessage (ofProxy self) message
-    case newMessage of
-      Just m -> return $ Just $ Right m
-      Nothing -> return $ Just $ Left self
-    where
-      -- ofProxy just provides reifies the phantom type k so the type system can
-      -- figure out what instance to go to.
-      ofProxy :: ReinterpretMessage k a -> Proxy k
-      ofProxy _ = Proxy
-
-modifyMosaic :: l a -> ModifiedLayout (ReinterpretMessage "ForMosaic") l a
-modifyMosaic = ModifiedLayout ReinterpretMessage
-
-reinterpretIncMaster ::
-  l a -> ModifiedLayout (ReinterpretMessage "IncMasterToResizeMaster") l a
-reinterpretIncMaster = ModifiedLayout ReinterpretMessage
-
-mods =
-  ModifiedLayout (Zoomable False 0.05 0.05) .
-    ModifiedLayout (Flippable False) .
-    ModifiedLayout (HFlippable False) .
-    ModifiedLayout (Rotateable False)
-
-
-data ModifyDescription m l a = ModifyDescription m (l a)
-  deriving (Show, Read)
-
-data TallDescriptionModifier = TallDescriptionModifier
-  deriving (Show, Read)
-
-data ThreeColDescMod = ThreeColDescMod
-  deriving (Show, Read)
-
-class DescriptionModifier m l where
-  newDescription :: m -> l a -> String -> String
-
-instance (Typeable m, Show m, DescriptionModifier m l, LayoutClass l a) => LayoutClass (ModifyDescription m l) a where
-  runLayout (W.Workspace t (ModifyDescription m l) a) rect = do
-    (rects, maybeNewLayout) <- runLayout (W.Workspace t l a) rect
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  doLayout (ModifyDescription m l) a s = do
-    (rects, maybeNewLayout) <- doLayout l a s
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  pureLayout (ModifyDescription m l) a s = pureLayout l a s
-
-  emptyLayout (ModifyDescription m l) a = do
-    (rects, maybeNewLayout) <- emptyLayout l a
-    return (rects, fmap (ModifyDescription m) maybeNewLayout)
-
-  handleMessage (ModifyDescription m l) a = do
-    maybeNewLayout <- handleMessage l a
-    return (ModifyDescription m <$> maybeNewLayout)
-
-  pureMessage (ModifyDescription m l) a =
-    let maybeNewLayout = pureMessage l a in
-      ModifyDescription m <$> maybeNewLayout
-
-  description (ModifyDescription m l) = newDescription m l (description l)
-
-instance DescriptionModifier TallDescriptionModifier Tall where
-  newDescription _ (Tall mast _ _) _ = "Tall(" ++ show mast ++ ")"
-
-instance DescriptionModifier ThreeColDescMod ThreeCol where
-  newDescription _ (ThreeCol mast _ _) _ = "ThreeCol(" ++ show mast ++ ")"
-  newDescription _ (ThreeColMid mast _ _) _ = "ThreeColMid(" ++ show mast ++ ")"
-
-data ResizeZoom = ShrinkZoom | ExpandZoom deriving (Typeable)
-
-instance Message ResizeZoom where
-
-newtype Flippable a = Flippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype HFlippable a = HFlippable Bool -- True if flipped
-  deriving (Show, Read)
-
-newtype Rotateable a = Rotateable Bool -- True if rotated
-  deriving (Show, Read)
-
-data FlipLayout = FlipLayout deriving (Typeable)
-
-data HFlipLayout = HFlipLayout deriving (Typeable)
-
-data DoRotate = DoRotate deriving (Typeable)
-
-data Zoomable a = Zoomable Bool Float Float -- True if zooming in on the focused window.
-  deriving (Show, Read)
-
--- Toggles if the current window should be zoomed or not. Set the boolean
--- to set the zoom.mhar
-data ZoomModifier =
-       ToggleZoom |
-       Zoom |
-       Unzoom
-  deriving (Typeable)
-
-instance Message FlipLayout where
-
-instance Message HFlipLayout where
-
-instance Message ZoomModifier where
-
-instance Message DoRotate where
-
-instance (Eq a) => LayoutModifier Rotateable a where
-  pureModifier (Rotateable rotate) (Rectangle x' y' sw sh) _ returned =
-    if rotate
-      then (map (second (unzero . scaleRect . mirrorRect . zero)) returned, Nothing)
-      else (returned, Nothing)
-    where
-      zero (Rectangle x y w h) = Rectangle (x - x') (y - y') w h
-      unzero (Rectangle x y w h) = Rectangle (x + x') (y + y') w h
-
-      scaleRect (Rectangle x y w h) =
-        Rectangle (x * fi sw `div` fi sh)
-                  (y * fi sh `div` fi sw)
-                  (w * sw `div` sh)
-                  (h * sh `div` sw)
-
-      fi = fromIntegral
-
-
-  pureMess (Rotateable rot) mess =
-    fmap (\DoRotate -> Rotateable (not rot)) (fromMessage mess)
-
-  modifyDescription (Rotateable rot) underlying =
-    let descr = description underlying in
-      if rot
-        then descr ++ " Rotated"
-        else descr
-
-instance (Eq a) => LayoutModifier Flippable a where
-  pureModifier (Flippable flip) (Rectangle sx _ sw _) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle ((sx + fromIntegral sw) - x - fromIntegral w + sx) y w h
-
-  pureMess (Flippable flip) message =
-    case fromMessage message of
-      Just FlipLayout -> Just (Flippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (Flippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " Flipped"
-        else descr
-
-instance (Eq a) => LayoutModifier HFlippable a where
-  pureModifier (HFlippable flip) (Rectangle _ sy _ sh) stack returned =
-    if flip
-      then (map (second doFlip) returned, Nothing)
-      else (returned, Nothing)
-    where
-      doFlip (Rectangle x y w h) =
-        Rectangle x ((sy + fromIntegral sh) - y - fromIntegral h + sy) w h
-
-  pureMess (HFlippable flip) message =
-    case fromMessage message of
-      Just HFlipLayout -> Just (HFlippable (not flip))
-      Nothing -> Nothing
-
-  modifyDescription (HFlippable flipped) underlying =
-    let descr = description underlying in
-      if flipped
-        then descr ++ " HFlipped"
-        else descr
-
-
-instance (Eq a) => LayoutModifier Zoomable a where
-  redoLayout (Zoomable doit ws hs) (Rectangle x y w h) stack returned =
-    if doit
-      then
-        let focused = W.focus <$> stack
-            (zoomed, rest) = partition ((==focused) . Just . fst) returned
-         in case zoomed of
-              [] -> return (rest, Nothing)
-              ((fwin, _):_) ->  return ((fwin, Rectangle (x + wp) (y + hp) (w - fromIntegral (wp * 2)) (h - fromIntegral (hp * 2))) : rest, Nothing)
-
-      else return (returned, Nothing)
-    where
-      wp = floor $ fromIntegral w * ws
-      hp = floor $ fromIntegral h * hs
-
-  handleMessOrMaybeModifyIt self@(Zoomable showing sw sh) mess =
-    return $
-      (handleResize <$> fromMessage mess)
-        <|> (Left . handleZoom <$> fromMessage mess)
-      where
-        handleResize r =
-          if showing
-            then Left $ Zoomable showing (guard $ sw + d) (guard $ sh + d)
-            else Right $ case r of
-                   ShrinkZoom -> SomeMessage Shrink
-                   ExpandZoom -> SomeMessage Expand
-
-          where d = (case r of
-                      ShrinkZoom -> -1
-                      ExpandZoom -> 1) * 0.02
-
-        handleZoom ToggleZoom = Zoomable (not showing) sw sh
-        handleZoom Zoom = Zoomable True sw sh
-        handleZoom Unzoom = Zoomable False sw sh
-
-        guard f | f > 1 = 1
-                | f < 0 = 0
-                | otherwise = f