diff --git a/Graphics/Aosd.hs b/Graphics/Aosd.hs --- a/Graphics/Aosd.hs +++ b/Graphics/Aosd.hs @@ -112,7 +112,7 @@ -- | Must *NOT* access the aosdStructOwnedDataVar of the AosdPtr argument (-> deadlock). reconfigure0 :: (AosdRenderer renderer) => AosdOptions -> renderer -> AosdPtr -> IO AosdStructOwnedData -reconfigure0 AosdOptions{..} renderer aosd@AosdPtr {unAosdPtr=ptr, display} = +reconfigure0 AosdOptions{..} renderer aosd@AosdPtr {unAosdPtr=ptr, display} = do GeneralRenderer{..} <- toGeneralRenderer renderer @@ -142,7 +142,7 @@ maybeDo (setClassHint ptr) classHint maybeDo (setHideUponMouseEvent ptr) hideUponMouseEvent - + rendererPtr <- setRenderer ptr finalRenderer handlerPtr <- traverseMaybe (setMouseEventCB aosd) mouseEventCB @@ -212,7 +212,7 @@ aosdNew :: (AosdRenderer renderer) => AosdOptions -> renderer -> IO AosdPtr aosdNew opts r = do - aosd <- aosdNew0 + aosd <- aosdNew0 z <- reconfigure0 opts r aosd modifyMVar_ (aosdStructOwnedDataVar aosd) (\x -> assert (isNothing x) $ return (Just z)) @@ -234,7 +234,7 @@ return (Just zNew)) wrapAosd :: (Ptr C'Aosd -> c) -> AosdPtr -> c -wrapAosd f = f . unAosdPtr +wrapAosd f = f . unAosdPtr aosdRender :: AosdPtr -> IO () aosdRender = wrapAosd c'aosd_render @@ -255,9 +255,9 @@ aosdLoopFor a millis = wrapAosd (flip c'aosd_loop_for millis) a -data AosdStructOwnedData = - AosdStructOwnedData - !(StablePtr (Cairo -> IO ())) +data AosdStructOwnedData = + AosdStructOwnedData + !(StablePtr (Cairo -> IO ())) !(Maybe (StablePtr (Ptr C'AosdMouseEvent -> IO()))) @@ -268,7 +268,7 @@ maybeDo (freeStablePtrDebug cxt "mouse event handler") sp_h aosdDestroy :: AosdPtr -> IO () -aosdDestroy AosdPtr {unAosdPtr, aosdStructOwnedDataVar, display} = +aosdDestroy AosdPtr {unAosdPtr, aosdStructOwnedDataVar, display} = modifyMVar_ aosdStructOwnedDataVar $ \z -> do c'aosd_destroy_debug "aosdDestroy" unAosdPtr maybeDo (freeAosdStructOwnedData "aosdDestroy") z @@ -276,6 +276,6 @@ return Nothing --- | 'aosdNew'/'aosdDestroy' bracket. Leaking the 'AosdPtr' out of the third argument leads to undefined behaviour. +-- | 'aosdNew'/'aosdDestroy' bracket. Leaking the 'AosdPtr' out of the third argument leads to undefined behaviour. withAosd :: AosdRenderer renderer => AosdOptions -> renderer -> (AosdPtr -> IO c) -> IO c withAosd opts ren = bracket (aosdNew opts ren) aosdDestroy diff --git a/Graphics/Aosd/AOSD_H.hsc b/Graphics/Aosd/AOSD_H.hsc --- a/Graphics/Aosd/AOSD_H.hsc +++ b/Graphics/Aosd/AOSD_H.hsc @@ -11,7 +11,7 @@ #opaque_t Aosd -#integral_t AosdCoordinate +#integral_t AosdCoordinate #num COORDINATE_MINIMUM #num COORDINATE_CENTER #num COORDINATE_MAXIMUM @@ -38,9 +38,9 @@ #field res_class, CString #stoptype -#ccall aosd_new, IO (Ptr ) +#ccall aosd_new, IO (Ptr ) #ccall aosd_destroy, Ptr -> IO () - + -- * object configurators #ccall aosd_set_name, Ptr -> Ptr -> IO () diff --git a/Graphics/Aosd/CallbackUtil.hs b/Graphics/Aosd/CallbackUtil.hs --- a/Graphics/Aosd/CallbackUtil.hs +++ b/Graphics/Aosd/CallbackUtil.hs @@ -15,22 +15,22 @@ -- delegates the @a@ to that @a -> IO ()@. newtype UniversalCallback a = UniversalCallback (FunPtr (Callback a)) -mkUniversalCallback :: forall a. - (Callback a -> IO (FunPtr (Callback a))) - -- ^ Should be something obtained from a @foreign import ccall \"wrapper\" ...@ declaration +mkUniversalCallback :: forall a. + (Callback a -> IO (FunPtr (Callback a))) + -- ^ Should be something obtained from a @foreign import ccall \"wrapper\" ...@ declaration -> IO (UniversalCallback a) -mkUniversalCallback foreignImportWrapper = +mkUniversalCallback foreignImportWrapper = UniversalCallback `fmap` foreignImportWrapper universalCallback universalCallback :: a -> Ptr () -> IO () universalCallback a userData = do - handler <- deRefStablePtr (castPtrToStablePtr userData) :: IO (a -> IO ()) + handler <- deRefStablePtr (castPtrToStablePtr userData) :: IO (a -> IO ()) handler a -tunnelCallback :: - UniversalCallback a - -> (FunPtr (Callback a) -> UserData -> IO ()) -- ^ The C-imported callback setter function - -> (a -> IO ()) -- ^ The haskell function you want to be called back +tunnelCallback :: + UniversalCallback a + -> (FunPtr (Callback a) -> UserData -> IO ()) -- ^ The C-imported callback setter function + -> (a -> IO ()) -- ^ The haskell function you want to be called back -> IO (StablePtr (a -> IO ())) -- ^ Returns a StablePtr which needs to be freed once the callback is no longer used tunnelCallback (UniversalCallback u) setCallback haskellCallback = do diff --git a/Graphics/Aosd/Pango.hs b/Graphics/Aosd/Pango.hs --- a/Graphics/Aosd/Pango.hs +++ b/Graphics/Aosd/Pango.hs @@ -26,8 +26,8 @@ module Data.Monoid, module Data.Colour.Names - - + + ) where import Graphics.Aosd hiding(width) @@ -69,7 +69,7 @@ } data Width = Unlimited -- ^ The layout will be as wide as necessary to hold all the lines without wrapping - | Width Double -- ^ The layout will be wrapped (according to 'wrapMode') to the given width in Pango units + | Width Double -- ^ The layout will be wrapped (according to 'wrapMode') to the given width in Pango units deriving(Show,Eq) unsup :: String -> t @@ -110,7 +110,7 @@ -- | Plain text or some Pango markup. Suggestion: Use {-\# LANGUAGE OverloadedStrings \#-}. data PangoText = PlainText ShowS - | PangoMarkup ShowS + | PangoMarkup ShowS | Empty toMarkup :: PangoText -> ShowS @@ -118,15 +118,18 @@ toMarkup (PangoMarkup s) = s toMarkup Empty = mempty --- | Uses 'pText' (not 'pRaw'). +-- | Uses 'pText' (not 'pRaw'). instance IsString PangoText where fromString = pText +instance Semigroup PangoText where + (<>) = mappend + instance Monoid PangoText where mempty = Empty mappend Empty x2 = x2 mappend x1 Empty = x1 - mappend (PlainText s1) (PlainText s2) = PlainText (s1 . s2) + mappend (PlainText s1) (PlainText s2) = PlainText (s1 . s2) mappend x1 x2 = PangoMarkup (toMarkup x1 . toMarkup x2) instance Show PangoText where @@ -172,10 +175,10 @@ pTag :: String -- ^ Tag name -> PangoText -> PangoText -pTag tagName inner = PangoMarkup $ - showChar '<' . showString tagName . showChar '>' . - toMarkup inner . - showString "' +pTag tagName inner = PangoMarkup $ + showChar '<' . showString tagName . showChar '>' . + toMarkup inner . + showString "' pBold :: PangoText -> PangoText pBold = pTag "b" @@ -194,32 +197,30 @@ -- | Superscript pSup :: PangoText -> PangoText pSup = pTag "sup" - + pSmall :: PangoText -> PangoText pSmall = pTag "small" - + -- | Monospace font pMono :: PangoText -> PangoText pMono = pTag "tt" - --- | Underline + +-- | Underline pUnderline :: PangoText -> PangoText pUnderline = pTag "u" - - - + + + layoutSetWidth' :: PangoLayout -> Width -> IO () layoutSetWidth' layout w = layoutSetWidth layout (case w of Unlimited -> Nothing Width x -> Just x) - - instance AosdRenderer TextRenderer where toGeneralRenderer TextRenderer{..} = do fm <- cairoFontMapGetDefault @@ -229,13 +230,13 @@ case tcText of Empty -> return () - PlainText s -> layoutSetText layout (s "") - PangoMarkup s -> void (layoutSetMarkup layout (s "")) + PlainText s -> layoutSetText layout (s "") + PangoMarkup s -> void (layoutSetMarkup layout (s "") :: IO String) - let go :: (PangoLayout -> a -> IO ()) -> Maybe a -> IO () + let go :: (PangoLayout -> a -> IO ()) -> Maybe a -> IO () go f = maybeDo (f layout) - + go layoutSetWidth' width go layoutSetWrap wrapMode go layoutSetJustify justify @@ -252,7 +253,7 @@ showLayout layout - return GeneralRenderer { grInkExtent, grPositioningExtent, grRender = render } + return GeneralRenderer { grInkExtent, grPositioningExtent, grRender = render } @@ -261,17 +262,17 @@ -- getSize l = do -- -- (ink,logical) -- a@(Rectangle xi yi wi hi, Rectangle xl yl wl hl) <- layoutGetPixelExtents l --- +-- -- -- print ("ink",fst a) -- -- print ("logical",snd a) --- +-- -- let w = max (xi+wi) (xl+wl) -- h = max (yi+hi) (yl+hl) --- --- +-- +-- -- return (fi w, fi h) --- +-- -- where -- fi = fromIntegral --- --- +-- +-- diff --git a/Graphics/Aosd/Renderer.hs b/Graphics/Aosd/Renderer.hs --- a/Graphics/Aosd/Renderer.hs +++ b/Graphics/Aosd/Renderer.hs @@ -23,7 +23,7 @@ -- (Likewise for the /y/ axis) grPositioningExtent :: Rectangle } - + instance AosdRenderer GeneralRenderer where toGeneralRenderer = return diff --git a/Graphics/Aosd/Util.hs b/Graphics/Aosd/Util.hs --- a/Graphics/Aosd/Util.hs +++ b/Graphics/Aosd/Util.hs @@ -32,13 +32,13 @@ fi = fromIntegral rectLeft :: Rectangle -> Int -rectLeft (Rectangle a _ _ _) = a +rectLeft (Rectangle a _ _ _) = a rectTop :: Rectangle -> Int -rectTop (Rectangle _ a _ _) = a +rectTop (Rectangle _ a _ _) = a rectWidth :: Rectangle -> Int -rectWidth (Rectangle _ _ a _) = a +rectWidth (Rectangle _ _ a _) = a rectHeight :: Rectangle -> Int -rectHeight (Rectangle _ _ _ a) = a +rectHeight (Rectangle _ _ _ a) = a rectRight :: Rectangle -> Int rectRight r = rectLeft r + rectWidth r @@ -94,19 +94,19 @@ newStablePtrDebug :: String -> String -> a -> IO (StablePtr a) newStablePtrDebug cxt descr a = do sp <- newStablePtr a - putDebugMemory cxt ("Created "++descr++" StablePtr: "++showStablePtr sp) + putDebugMemory cxt ("Created "++descr++" StablePtr: "++showStablePtr sp) return sp freeStablePtrDebug :: String -> String -> StablePtr a -> IO () freeStablePtrDebug cxt descr sp = do - putDebugMemory cxt ("Freeing "++descr++" StablePtr: "++showStablePtr sp) + putDebugMemory cxt ("Freeing "++descr++" StablePtr: "++showStablePtr sp) freeStablePtr sp newForeignPtrDebug :: String -> String -> IO () -> Ptr a -> IO (ForeignPtr a) newForeignPtrDebug cxt descr finalizer p = do - fp <- newForeignPtr p + fp <- newForeignPtr p (do - putDebugMemory "ForeignPtr finalizer" ("Finalizing "++descr++" ForeignPtr made in "++cxt) + putDebugMemory "ForeignPtr finalizer" ("Finalizing "++descr++" ForeignPtr made in "++cxt) finalizer) putDebugMemory cxt ("Created "++descr++" ForeignPtr: "++show fp) return fp diff --git a/aosd.cabal b/aosd.cabal --- a/aosd.cabal +++ b/aosd.cabal @@ -2,7 +2,7 @@ -- see -- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. Name: aosd -Version: 0.2.1 +Version: 0.2.2 Synopsis: Bindings to libaosd, a library for Cairo-based on-screen displays Description: @@ -23,7 +23,7 @@ . main = do \ withAosd - \ defaultOpts + \ defaultOpts \ (textRenderer markup) { alignment = Just AlignCenter, colour = orange } \ (\a -> aosdFlash a (symDurations 3000 3000)) @ @@ -39,10 +39,11 @@ Build-type: Simple Extra-source-files: test/test.hs Cabal-version: >=1.10 +extra-source-files: changelog.markdown source-repository head - type: hg - location: https://dschuessler@bitbucket.org/dschuessler/haskell-aosd + type: git + location: https://github.com/DanielSchuessler/haskell-aosd Flag DebugMemory Default: False diff --git a/changelog.markdown b/changelog.markdown new file mode 100644 --- /dev/null +++ b/changelog.markdown @@ -0,0 +1,4 @@ +## 0.2.2 + +* Fixed build with GHC 8.6.5 (Thanks to Allen Haim) +* Converted Repository to git and migrated project to Github