    {-# LANGUAGE ViewPatterns #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module     :  XMonad.Actions.Workscreen
    -- Description:  Display a set of workspaces on several screens.
    -- Copyright  :  (c) 2012 kedals0
    -- License    :  BSD3-style (see LICENSE)
    --
    -- Maintainer :  Dal <kedasl0@gmail.com>
    -- Stability  :  unstable
    -- Portability:  unportable
    --
    -- A workscreen permits to display a set of workspaces on several
    -- screens. In xinerama mode, when a workscreen is viewed, workspaces
    -- associated to all screens are visible.
    --
    -- The first workspace of a workscreen is displayed on first screen,
    -- second on second screen, etc. Workspace position can be easily
    -- changed. If the current workscreen is called again, workspaces are
    -- shifted.
    --
    -- This also permits to see all workspaces of a workscreen even if just
    -- one screen is present, and to move windows from workspace to workscreen.
    -----------------------------------------------------------------------------

    module XMonad.Actions.Workscreen (
      -- * Usage
      -- $usage
      configWorkscreen
      ,viewWorkscreen
      ,Workscreen(..)
      ,shiftToWorkscreen
      ,fromWorkspace
      ,expandWorkspace
      ,WorkscreenId
      ) where

    import XMonad hiding (workspaces)
    import XMonad.Prelude
    import qualified XMonad.StackSet as W
    import qualified XMonad.Util.ExtensibleState as XS
    import XMonad.Actions.OnScreen

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- > import XMonad.Actions.Workscreen
    -- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
    -- >                in Workscreen.expandWorkspace 2 myOldWorkspaces
    -- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces)
    -- >                    return ()
    --
    -- Then, replace normal workspace view and shift keybinding:
    --
    -- > [((m .|. modm, k), f i)
    -- >      | (i, k) <- zip [0..] [1..12]
    -- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
    --
    -- For detailed instructions on editing your key bindings, see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

    data Workscreen = Workscreen{Workscreen -> Int
    workscreenId::Int,Workscreen -> [WorkspaceId]
    workspaces::[WorkspaceId]} deriving (Int -> Workscreen -> ShowS
    [Workscreen] -> ShowS
    Workscreen -> WorkspaceId
    (Int -> Workscreen -> ShowS)
    -> (Workscreen -> WorkspaceId)
    -> ([Workscreen] -> ShowS)
    -> Show Workscreen
    forall a.
    (Int -> a -> ShowS)
    -> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Workscreen -> ShowS
    showsPrec :: Int -> Workscreen -> ShowS
    $cshow :: Workscreen -> WorkspaceId
    show :: Workscreen -> WorkspaceId
    $cshowList :: [Workscreen] -> ShowS
    showList :: [Workscreen] -> ShowS
    Show)
    type WorkscreenId=Int

    data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Int -> WorkscreenStorage -> ShowS
    [WorkscreenStorage] -> ShowS
    WorkscreenStorage -> WorkspaceId
    (Int -> WorkscreenStorage -> ShowS)
    -> (WorkscreenStorage -> WorkspaceId)
    -> ([WorkscreenStorage] -> ShowS)
    -> Show WorkscreenStorage
    forall a.
    (Int -> a -> ShowS)
    -> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> WorkscreenStorage -> ShowS
    showsPrec :: Int -> WorkscreenStorage -> ShowS
    $cshow :: WorkscreenStorage -> WorkspaceId
    show :: WorkscreenStorage -> WorkspaceId
    $cshowList :: [WorkscreenStorage] -> ShowS
    showList :: [WorkscreenStorage] -> ShowS
    Show)
    instance ExtensionClass WorkscreenStorage where
      initialValue :: WorkscreenStorage
    initialValue = Int -> [Workscreen] -> WorkscreenStorage
    WorkscreenStorage Int
    0 []

    -- | Helper to group workspaces. Multiply workspace by screens number.
    expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
    expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
    expandWorkspace Int
    nscr = (WorkspaceId -> [WorkspaceId]) -> [WorkspaceId] -> [WorkspaceId]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap WorkspaceId -> [WorkspaceId]
    expandId
      where expandId :: WorkspaceId -> [WorkspaceId]
    expandId WorkspaceId
    wsId = let t :: WorkspaceId
    t = WorkspaceId
    wsId WorkspaceId -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ WorkspaceId
    "_"
                            in (Int -> WorkspaceId) -> [Int] -> [WorkspaceId]
    forall a b. (a -> b) -> [a] -> [b]
    map (WorkspaceId -> ShowS
    forall a. [a] -> [a] -> [a]
    (++) WorkspaceId
    t ShowS -> (Int -> WorkspaceId) -> Int -> WorkspaceId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> WorkspaceId
    forall a. Show a => a -> WorkspaceId
    show ) [Int
    1..Int
    nscr]

    -- | Create workscreen list from workspace list. Group workspaces to
    -- packets of screens number size.
    fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
    fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
    fromWorkspace Int
    n [WorkspaceId]
    ws = (Int -> [WorkspaceId] -> Workscreen)
    -> [Int] -> [[WorkspaceId]] -> [Workscreen]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> [WorkspaceId] -> Workscreen
    Workscreen [Int
    0..] (Int -> [WorkspaceId] -> [[WorkspaceId]]
    fromWorkspace' Int
    n [WorkspaceId]
    ws)
    fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
    fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
    fromWorkspace' Int
    _ [] = []
    fromWorkspace' Int
    n [WorkspaceId]
    ws = Int -> [WorkspaceId] -> [WorkspaceId]
    forall a. Int -> [a] -> [a]
    take Int
    n [WorkspaceId]
    ws [WorkspaceId] -> [[WorkspaceId]] -> [[WorkspaceId]]
    forall a. a -> [a] -> [a]
    : Int -> [WorkspaceId] -> [[WorkspaceId]]
    fromWorkspace' Int
    n (Int -> [WorkspaceId] -> [WorkspaceId]
    forall a. Int -> [a] -> [a]
    drop Int
    n [WorkspaceId]
    ws)

    -- | Initial configuration of workscreens
    configWorkscreen :: [Workscreen] -> X ()
    configWorkscreen :: [Workscreen] -> X ()
    configWorkscreen [Workscreen]
    wscrn = WorkscreenStorage -> X ()
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
    XS.put (Int -> [Workscreen] -> WorkscreenStorage
    WorkscreenStorage Int
    0 [Workscreen]
    wscrn)

    -- | View workscreen of index @WorkscreenId@. If current workscreen is asked
    -- workscreen, workscreen's workspaces are shifted.
    viewWorkscreen :: WorkscreenId -> X ()
    viewWorkscreen :: Int -> X ()
    viewWorkscreen Int
    wscrId = do (WorkscreenStorage c a) <- X WorkscreenStorage
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
                               let wscr = if Int
    wscrId Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    c
                                              then Int -> [WorkspaceId] -> Workscreen
    Workscreen Int
    wscrId ([WorkspaceId] -> Workscreen) -> [WorkspaceId] -> Workscreen
    forall a b. (a -> b) -> a -> b
    $ [WorkspaceId] -> [WorkspaceId]
    shiftWs (Workscreen -> [WorkspaceId]
    workspaces (Workscreen -> [WorkspaceId]) -> Workscreen -> [WorkspaceId]
    forall a b. (a -> b) -> a -> b
    $ [Workscreen]
    a [Workscreen] -> Int -> Workscreen
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    wscrId)
                                              else [Workscreen]
    a [Workscreen] -> Int -> Workscreen
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    wscrId
                                   (x, notEmpty -> _ :| ys) = splitAt wscrId a
                                   newWorkscreenStorage = Int -> [Workscreen] -> WorkscreenStorage
    WorkscreenStorage Int
    wscrId ([Workscreen]
    x [Workscreen] -> [Workscreen] -> [Workscreen]
    forall a. [a] -> [a] -> [a]
    ++ [Workscreen
    wscr] [Workscreen] -> [Workscreen] -> [Workscreen]
    forall a. [a] -> [a] -> [a]
    ++ [Workscreen]
    ys)
                               windows (viewWorkscreen' wscr)
                               XS.put newWorkscreenStorage

    viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
    viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
    viewWorkscreen' (Workscreen Int
    _ [WorkspaceId]
    ws) = \WindowSet
    s -> (WindowSet -> (ScreenId, WorkspaceId) -> WindowSet)
    -> WindowSet -> [(ScreenId, WorkspaceId)] -> WindowSet
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl WindowSet -> (ScreenId, WorkspaceId) -> WindowSet
    wsToSc' WindowSet
    s ([ScreenId] -> [WorkspaceId] -> [(ScreenId, WorkspaceId)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [ScreenId
    0..] [WorkspaceId]
    ws)
      where wsToSc' :: WindowSet -> (ScreenId, WorkspaceId) -> WindowSet
    wsToSc' WindowSet
    s (ScreenId
    scr,WorkspaceId
    wsId) = ScreenId -> WorkspaceId -> WindowSet -> WindowSet
    greedyViewOnScreen ScreenId
    scr WorkspaceId
    wsId WindowSet
    s

    shiftWs :: [WorkspaceId] -> [WorkspaceId]
    shiftWs :: [WorkspaceId] -> [WorkspaceId]
    shiftWs [WorkspaceId]
    a = Int -> [WorkspaceId] -> [WorkspaceId]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [WorkspaceId]
    a [WorkspaceId] -> [WorkspaceId] -> [WorkspaceId]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [WorkspaceId] -> [WorkspaceId]
    forall a. Int -> [a] -> [a]
    take Int
    1 [WorkspaceId]
    a

    -- | Shift a window on the first workspace of workscreen
    -- @WorkscreenId@.
    shiftToWorkscreen :: WorkscreenId -> X ()
    shiftToWorkscreen :: Int -> X ()
    shiftToWorkscreen Int
    wscrId = do (WorkscreenStorage _ a) <- X WorkscreenStorage
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get
                                  case workspaces (a !! wscrId) of
                                    []      -> () -> X ()
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                                    (WorkspaceId
    w : [WorkspaceId]
    _) -> (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ WorkspaceId -> WindowSet -> WindowSet
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> StackSet i l a s sd -> StackSet i l a s sd
    W.shift WorkspaceId
    w