{-# LINE 1 "src/Xmobar/X11/XPMFile.hsc" #-}
{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}
module Xmobar.X11.XPMFile(readXPMFile) where
{-# LINE 17 "src/Xmobar/X11/XPMFile.hsc" #-}
import Control.Monad.Except(MonadError(..))
{-# LINE 21 "src/Xmobar/X11/XPMFile.hsc" #-}
import Control.Monad.Trans(MonadIO(..))
import Graphics.X11.Xlib(Dimension, Display(..), Drawable, Pixmap)
import Foreign.C.String(CString, withCString)
import Foreign.C.Types(CInt(..), CLong)
import Foreign.Ptr(Ptr)
import Foreign.Marshal.Alloc(alloca, allocaBytes)
import Foreign.Storable(peek, peekByteOff, pokeByteOff)
foreign import ccall "XpmReadFileToPixmap"
xpmReadFileToPixmap :: Display -> Drawable -> CString -> Ptr Pixmap -> Ptr Pixmap -> Ptr () -> IO CInt
readXPMFile
:: (MonadError String m, MonadIO m)
=> Display
-> Drawable
-> String
-> m (Dimension, Dimension, Pixmap, Maybe Pixmap)
readXPMFile :: forall (m :: * -> *).
(MonadError String m, MonadIO m) =>
Display
-> Drawable
-> String
-> m (Dimension, Dimension, Drawable, Maybe Drawable)
readXPMFile Display
display Drawable
d String
filename =
IO (Either String (Dimension, Dimension, Drawable, Maybe Drawable))
-> m (Dimension, Dimension, Drawable, Maybe Drawable)
forall {a} {m :: * -> *} {b}.
(MonadError a m, MonadIO m) =>
IO (Either a b) -> m b
toError (IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
-> m (Dimension, Dimension, Drawable, Maybe Drawable))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
-> m (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. (a -> b) -> a -> b
$ String
-> (CString
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. String -> (CString -> IO a) -> IO a
withCString String
filename ((CString
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> (CString
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \CString
c_filename ->
(Ptr Drawable
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Drawable
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> (Ptr Drawable
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \Ptr Drawable
pixmap_return ->
(Ptr Drawable
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Drawable
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> (Ptr Drawable
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \Ptr Drawable
shapemask_return ->
Int
-> (Ptr ()
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
224)) ((Ptr ()
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> (Ptr ()
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \Ptr ()
attributes -> do
{-# LINE 45 "src/Xmobar/X11/XPMFile.hsc" #-}
((\Ptr ()
hsc_ptr -> Ptr () -> Int -> CLong -> IO ()
forall b. Ptr b -> Int -> CLong -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ()
hsc_ptr Int
0)) Ptr ()
attributes ((CLong
65536) :: CLong)
{-# LINE 46 "src/Xmobar/X11/XPMFile.hsc" #-}
res <- Display
-> Drawable
-> CString
-> Ptr Drawable
-> Ptr Drawable
-> Ptr ()
-> IO CInt
xpmReadFileToPixmap Display
display Drawable
d CString
c_filename Ptr Drawable
pixmap_return Ptr Drawable
shapemask_return Ptr ()
attributes
case res of
CInt
0 -> do
width <- ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO Dimension
forall b. Ptr b -> Int -> IO Dimension
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
28)) Ptr ()
attributes
{-# LINE 50 "src/Xmobar/X11/XPMFile.hsc" #-}
height <- ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO Dimension
forall b. Ptr b -> Int -> IO Dimension
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
32)) attributes
{-# LINE 51 "src/Xmobar/X11/XPMFile.hsc" #-}
pixmap <- peek pixmap_return
shapemask <- peek shapemask_return
return $ Right (width, height, pixmap, if shapemask == 0 then Nothing else Just shapemask)
CInt
1 -> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmColorError"
-1 -> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmOpenFailed"
-2 -> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmFileInvalid"
-3 -> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmNoMemory"
-4 -> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmColorFailed"
CInt
_ -> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable)))
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
-> IO
(Either String (Dimension, Dimension, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Dimension, Dimension, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: Unknown error"
where toError :: IO (Either a b) -> m b
toError IO (Either a b)
m = (a -> m b) -> (b -> m b) -> Either a b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m b
forall a. a -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m b) -> m (Either a b) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either a b) -> m (Either a b)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either a b)
m