From 4866f2e367dfcf22a9591231ba40948826a1b438 Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 21:10:59 +0100 Subject: Hierarchify darcs-hash:20071101201059-a5988-fc1f1262bec1b69e13ba18ae7cefeafc8c4471d4.gz --- XMonad/Util/Invisible.hs | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 XMonad/Util/Invisible.hs (limited to 'XMonad/Util/Invisible.hs') diff --git a/XMonad/Util/Invisible.hs b/XMonad/Util/Invisible.hs new file mode 100644 index 0000000..f387158 --- /dev/null +++ b/XMonad/Util/Invisible.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Util.Invisible +-- Copyright : (c) 2007 Andrea Rossato, David Roundy +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it, droundy@darcs.net +-- Stability : unstable +-- Portability : unportable +-- +-- A data type to store the layout state +-- +----------------------------------------------------------------------------- + +module XMonad.Util.Invisible ( + -- * Usage: + -- $usage + Invisible (..) + , whenIJust + , fromIMaybe + ) where + +-- $usage +-- A wrapper data type to store layout state that shouldn't be persisted across +-- restarts. A common wrapped type to use is @Maybe a@. +-- Invisible derives trivial definitions for Read and Show, so the wrapped data +-- type need not do so. + +newtype Invisible m a = I (m a) deriving (Monad, Functor) + +instance (Functor m, Monad m) => Read (Invisible m a) where + readsPrec _ s = [(fail "Read Invisible", s)] + +instance Monad m => Show (Invisible m a) where + show _ = "" + +whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m () +whenIJust (I (Just x)) f = f x +whenIJust (I Nothing) _ = return () + +fromIMaybe :: a -> Invisible Maybe a -> a +fromIMaybe _ (I (Just x)) = x +fromIMaybe a (I Nothing) = a -- cgit v1.2.3