{-# 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 :: Display
-> Drawable
-> String
-> m (Drawable, Drawable, Drawable, Maybe Drawable)
readXPMFile Display
display Drawable
d String
filename =
IO (Either String (Drawable, Drawable, Drawable, Maybe Drawable))
-> m (Drawable, Drawable, Drawable, Maybe Drawable)
forall (m :: * -> *) e b.
(MonadError e m, MonadIO m) =>
IO (Either e b) -> m b
toError (IO (Either String (Drawable, Drawable, Drawable, Maybe Drawable))
-> m (Drawable, Drawable, Drawable, Maybe Drawable))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
-> m (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. (a -> b) -> a -> b
$ String
-> (CString
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a. String -> (CString -> IO a) -> IO a
withCString String
filename ((CString
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> (CString
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \CString
c_filename ->
(Ptr Drawable
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Drawable
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> (Ptr Drawable
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \Ptr Drawable
pixmap_return ->
(Ptr Drawable
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Drawable
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> (Ptr Drawable
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ \Ptr Drawable
shapemask_return ->
Int
-> (Ptr ()
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes ((Int
140)) ((Ptr ()
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> (Ptr ()
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> IO
(Either String (Drawable, Drawable, 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 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" #-}
CInt
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 CInt
res of
CInt
0 -> do
Drawable
width <- ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO Drawable
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
16)) Ptr ()
attributes
{-# LINE 50 "src/Xmobar/X11/XPMFile.hsc" #-}
Drawable
height <- ((\Ptr ()
hsc_ptr -> Ptr () -> Int -> IO Drawable
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
hsc_ptr Int
20)) Ptr ()
attributes
{-# LINE 51 "src/Xmobar/X11/XPMFile.hsc" #-}
Drawable
pixmap <- Ptr Drawable -> IO Drawable
forall a. Storable a => Ptr a -> IO a
peek Ptr Drawable
pixmap_return
Drawable
shapemask <- Ptr Drawable -> IO Drawable
forall a. Storable a => Ptr a -> IO a
peek Ptr Drawable
shapemask_return
Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ (Drawable, Drawable, Drawable, Maybe Drawable)
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. b -> Either a b
Right (Drawable
width, Drawable
height, Drawable
pixmap, if Drawable
shapemask Drawable -> Drawable -> Bool
forall a. Eq a => a -> a -> Bool
== Drawable
0 then Maybe Drawable
forall a. Maybe a
Nothing else Drawable -> Maybe Drawable
forall a. a -> Maybe a
Just Drawable
shapemask)
CInt
1 -> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmColorError"
-1 -> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmOpenFailed"
-2 -> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmFileInvalid"
-3 -> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmNoMemory"
-4 -> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: XpmColorFailed"
CInt
_ -> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable)))
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
-> IO
(Either String (Drawable, Drawable, Drawable, Maybe Drawable))
forall a b. (a -> b) -> a -> b
$ String
-> Either String (Drawable, Drawable, Drawable, Maybe Drawable)
forall a b. a -> Either a b
Left String
"readXPMFile: Unknown error"
where toError :: IO (Either e b) -> m b
toError IO (Either e b)
m = (e -> m b) -> (b -> m b) -> Either e b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e b -> m b) -> m (Either e b) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Either e b) -> m (Either e b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either e b)
m