{-# LINE 1 "src/Xmobar/X11/XPMFile.hsc" #-}
{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XPMFile
-- Copyright   :  (C) 2014, 2018 Alexander Shabalin
-- License     :  BSD3
--
-- Maintainer  :  jao@gnu.org
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

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