    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.RandomBackground
    -- Copyright   :  (c) 2009 Anze Slosar
    --                translation to Haskell by Adam Vogt
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  <vogt.adam@gmail.com>
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- An action to start terminals with a random background color
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.RandomBackground (
        -- * Usage
        -- $usage
        randomBg',
        randomBg,
        RandomColor(HSV,RGB)
        ) where

    import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
                  MonadIO, asks)
    import System.Random
    import Control.Monad(liftM)
    import Numeric(showHex)

    -- $usage
    --
    -- Add to your keybindings something like:
    --
    -- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20

    -- | RandomColor fixes constraints when generating random colors. All
    -- parameters should be in the range 0 -- 0xff
    data RandomColor = RGB { RandomColor -> Int
    _colorMin :: Int
                           , RandomColor -> Int
    _colorMax :: Int
                           } -- ^ specify the minimum and maximum lowest values for each color channel.
                     | HSV { RandomColor -> Double
    _colorSaturation :: Double
                           , RandomColor -> Double
    _colorValue :: Double
                           } -- ^ specify the saturation and value, leaving the hue random.

    toHex :: [Int] -> String
    toHex :: [Int] -> String
    toHex =  ("'#"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> ([Int] -> String) -> [Int] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++"'") (String -> String) -> ([Int] -> String) -> [Int] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int -> String) -> [Int] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Int -> String -> String
    ensure 2 (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ "") ((String -> String) -> String)
    -> (Int -> String -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. (Integral a, Show a) => a -> String -> String
    showHex)
        where ensure :: Int -> String -> String
    ensure x :: Int
    x = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    x (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Char -> String
    forall a. a -> [a]
    repeat '0') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse

    randPermutation ::  (RandomGen g) => [a] -> g -> [a]
    randPermutation :: [a] -> g -> [a]
    randPermutation xs :: [a]
    xs g :: g
    g = [(Bool, a)] -> [a]
    forall b. [(Bool, b)] -> [b]
    swap ([(Bool, a)] -> [a]) -> [(Bool, a)] -> [a]
    forall a b. (a -> b) -> a -> b
    $ [Bool] -> [a] -> [(Bool, a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (g -> [Bool]
    forall a g. (Random a, RandomGen g) => g -> [a]
    randoms g
    g) [a]
    xs
      where
        swap :: [(Bool, b)] -> [b]
    swap ((True,x :: b
    x):(c :: Bool
    c,y :: b
    y):ys :: [(Bool, b)]
    ys) = b
    yb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[(Bool, b)] -> [b]
    swap ((Bool
    c,b
    x)(Bool, b) -> [(Bool, b)] -> [(Bool, b)]
    forall a. a -> [a] -> [a]
    :[(Bool, b)]
    ys)
        swap ((False,x :: b
    x):ys :: [(Bool, b)]
    ys) = b
    xb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[(Bool, b)] -> [b]
    swap [(Bool, b)]
    ys
        swap x :: [(Bool, b)]
    x = ((Bool, b) -> b) -> [(Bool, b)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, b) -> b
    forall a b. (a, b) -> b
    snd [(Bool, b)]
    x

    -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
    randomBg' ::  (MonadIO m) => RandomColor -> m String
    randomBg' :: RandomColor -> m String
    randomBg' (RGB l :: Int
    l h :: Int
    h) = IO String -> m String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO String -> m String) -> IO String -> m String
    forall a b. (a -> b) -> a -> b
    $ (StdGen -> String) -> IO StdGen -> IO String
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ([Int] -> String
    toHex ([Int] -> String) -> (StdGen -> [Int]) -> StdGen -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Int] -> [Int]
    forall a. Int -> [a] -> [a]
    take 3 ([Int] -> [Int]) -> (StdGen -> [Int]) -> StdGen -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Int, Int) -> StdGen -> [Int]
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
    randomRs (Int
    l,Int
    h)) IO StdGen
    newStdGen
    randomBg' (HSV s :: Double
    s v :: Double
    v) = IO String -> m String
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO String -> m String) -> IO String -> m String
    forall a b. (a -> b) -> a -> b
    $ do
        StdGen
    g <- IO StdGen
    newStdGen
        let x :: Double
    x = (Double -> Int -> Double
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(2::Int)) (Double -> Double) -> Double -> Double
    forall a b. (a -> b) -> a -> b
    $ (Double, StdGen) -> Double
    forall a b. (a, b) -> a
    fst ((Double, StdGen) -> Double) -> (Double, StdGen) -> Double
    forall a b. (a -> b) -> a -> b
    $ (Double, Double) -> StdGen -> (Double, StdGen)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR (0,Double -> Double
    forall a. Floating a => a -> a
    sqrt (Double -> Double) -> Double -> Double
    forall a b. (a -> b) -> a -> b
    $ Double
    forall a. Floating a => a
    pi Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / 3) StdGen
    g
        String -> IO String
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ [Int] -> String
    toHex ([Int] -> String) -> [Int] -> String
    forall a b. (a -> b) -> a -> b
    $ (Double -> Int) -> [Double] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Double -> Int
    forall a b. (RealFrac a, Integral b) => a -> b
    round ([Double] -> [Int]) -> [Double] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [Double] -> StdGen -> [Double]
    forall g a. RandomGen g => [a] -> g -> [a]
    randPermutation [Double
    v,(Double
    vDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    s)Double -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    x Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    s,Double
    s] StdGen
    g

    -- | @randomBg@ starts a terminal with the background color taken from 'randomBg''
    --
    -- This depends on the your 'terminal' configuration field accepting an
    -- argument like @-bg '#ff0023'@
    randomBg :: RandomColor -> X ()
    randomBg :: RandomColor -> X ()
    randomBg x :: RandomColor
    x = do
        String
    t <- (XConf -> String) -> X String
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks (XConfig Layout -> String
    forall (l :: * -> *). XConfig l -> String
    terminal (XConfig Layout -> String)
    -> (XConf -> XConfig Layout) -> XConf -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
        String
    c <- RandomColor -> X String
    forall (m :: * -> *). MonadIO m => RandomColor -> m String
    randomBg' RandomColor
    x
        String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    spawn (String -> X ()) -> String -> X ()
    forall a b. (a -> b) -> a -> b
    $ String
    t String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " -bg " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c