diff --git a/Graphics/Text/Font/Choose/Config.hs b/Graphics/Text/Font/Choose/Config.hs --- a/Graphics/Text/Font/Choose/Config.hs +++ b/Graphics/Text/Font/Choose/Config.hs @@ -15,7 +15,7 @@ import Data.Set (empty) -- For testing segfault source. import Control.Exception (bracket) -import Graphics.Text.Font.Choose.Result (throwNull, throwFalse, throwPtr) +import Graphics.Text.Font.Choose.Result (Word8, throwNull, throwFalse, throwPtr) -- | System configuration regarding available fonts. type Config = ForeignPtr Config' @@ -233,7 +233,7 @@ ret <- fcFontMatch nullPtr pattern' res' throwPtr res' $ thawPattern_ $ pure ret foreign import ccall "FcFontMatch" fcFontMatch :: - Config_ -> Pattern_ -> Ptr Int -> IO Pattern_ + Config_ -> Pattern_ -> Ptr Word8 -> IO Pattern_ -- | Returns the list of fonts sorted by closeness to p. If trim is `True`, -- elements in the list which don't include Unicode coverage not provided by @@ -259,7 +259,7 @@ y <- thawCharSet $ throwNull csp' return (x, y) foreign import ccall "FcFontSort" fcFontSort :: - Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_ + Config_ -> Pattern_ -> Bool -> CharSet_ -> Ptr Word8 -> IO FontSet_ -- | Creates a new pattern consisting of elements of font not appearing in pat, -- elements of pat not appearing in font and the best matching value from pat diff --git a/Graphics/Text/Font/Choose/FontSet.hs b/Graphics/Text/Font/Choose/FontSet.hs --- a/Graphics/Text/Font/Choose/FontSet.hs +++ b/Graphics/Text/Font/Choose/FontSet.hs @@ -57,15 +57,10 @@ thawFontSet fonts' = do -- Very hacky, but these debug statements must be in here to avoid segfaults. -- FIXME: Is there an alternative? - print "a" n <- get_fontSet_nfont fonts' - print "b" if n == 0 then return [] - else do - print "c" - ret <- forM [0..pred n] (\i -> thawPattern =<< get_fontSet_font fonts' i) - print "d" - return ret + else + forM [0..pred n] (\i -> thawPattern =<< get_fontSet_font fonts' i) foreign import ccall "get_fontSet_nfont" get_fontSet_nfont :: FontSet_ -> IO Int foreign import ccall "get_fontSet_font" get_fontSet_font :: FontSet_ -> Int -> IO Pattern_ diff --git a/Graphics/Text/Font/Choose/FontSet/API.hs b/Graphics/Text/Font/Choose/FontSet/API.hs --- a/Graphics/Text/Font/Choose/FontSet/API.hs +++ b/Graphics/Text/Font/Choose/FontSet/API.hs @@ -6,7 +6,7 @@ import Graphics.Text.Font.Choose.Config import Graphics.Text.Font.Choose.ObjectSet import Graphics.Text.Font.Choose.CharSet -import Graphics.Text.Font.Choose.Result (throwPtr) +import Graphics.Text.Font.Choose.Result (Word8, throwPtr) import Foreign.Ptr (Ptr, castPtr, nullPtr) import Foreign.ForeignPtr (withForeignPtr) @@ -47,7 +47,7 @@ ret <- fcFontSetMatch nullPtr fontss' n pattern' res' throwPtr res' $ thawPattern_ $ pure ret foreign import ccall "FcFontSetMatch" fcFontSetMatch :: - Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> Ptr Int -> IO Pattern_ + Config_ -> Ptr FontSet_ -> Int -> Pattern_ -> Ptr Word8 -> IO Pattern_ -- | Returns the list of fonts from sets sorted by closeness to pattern. -- If trim is `True`, elements in the list which don't include Unicode coverage @@ -74,4 +74,4 @@ ret' <- fcFontSetSort nullPtr fontss' n pattern' trim csp' res' throwPtr res' $ thawFontSet_ $ pure ret' foreign import ccall "FcFontSetSort" fcFontSetSort :: Config_ -> Ptr FontSet_ - -> Int -> Pattern_ -> Bool -> CharSet_ -> Ptr Int -> IO FontSet_ + -> Int -> Pattern_ -> Bool -> CharSet_ -> Ptr Word8 -> IO FontSet_ diff --git a/Graphics/Text/Font/Choose/Result.hs b/Graphics/Text/Font/Choose/Result.hs --- a/Graphics/Text/Font/Choose/Result.hs +++ b/Graphics/Text/Font/Choose/Result.hs @@ -1,16 +1,20 @@ -module Graphics.Text.Font.Choose.Result (Result(..), resultFromPointer, +module Graphics.Text.Font.Choose.Result (Result(..), Word8, resultFromPointer, Error(..), throwResult, throwInt, throwPtr, throwFalse, throwNull) where import Foreign.Storable (peek) import Foreign.Ptr (Ptr, nullPtr) import Control.Exception (throwIO, throw, Exception) +import Data.Word (Word8) data Result = Match | NoMatch | TypeMismatch | ResultNoId | OutOfMemory | Other - deriving (Eq, Show, Read, Enum) + deriving (Eq, Show, Read, Enum, Bounded) -resultFromPointer :: Ptr Int -> IO Result -resultFromPointer res = toEnum <$> peek res +resultFromPointer :: Ptr Word8 -> IO Result +resultFromPointer res = toEnum8 <$> peek res +toEnum8 :: Enum a => Word8 -> a +toEnum8 = toEnum . fromEnum + data Error = ErrTypeMismatch | ErrResultNoId | ErrOutOfMemory deriving (Eq, Show, Read) instance Exception Error @@ -25,7 +29,7 @@ throwInt x | x >= 0 && x <= 4 = throwResult $ toEnum x | otherwise = throwResult $ Other -throwPtr :: Ptr Int -> IO a -> IO (Maybe a) +throwPtr :: Ptr Word8 -> IO a -> IO (Maybe a) throwPtr a b = resultFromPointer a >>= flip throwResult b throwFalse :: Bool -> IO () diff --git a/Graphics/Text/Font/Choose/Value.hs b/Graphics/Text/Font/Choose/Value.hs --- a/Graphics/Text/Font/Choose/Value.hs +++ b/Graphics/Text/Font/Choose/Value.hs @@ -18,7 +18,7 @@ import GHC.Generics (Generic) import Data.Hashable (Hashable) -import Graphics.Text.Font.Choose.Result (throwNull, Error(ErrTypeMismatch)) +import Graphics.Text.Font.Choose.Result (Word8, throwNull, Error(ErrTypeMismatch)) -- | A dynamic type system for `Pattern`s. data Value = ValueVoid @@ -148,7 +148,7 @@ thawValue :: Value_ -> IO (Maybe Value) thawValue ptr = do - kind <- peek ptr + kind <- peek $ castPtr ptr :: IO Word8 let val' = castPtr (ptr `advancePtr` 1) case kind of 0 -> return $ Just ValueVoid diff --git a/fontconfig-pure.cabal b/fontconfig-pure.cabal --- a/fontconfig-pure.cabal +++ b/fontconfig-pure.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.1.1 +version: 0.2.0.0 -- A short (one-line) description of the package. synopsis: Pure-functional language bindings to FontConfig @@ -68,7 +68,7 @@ -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.12 && <4.13, containers >= 0.1 && <1, + build-depends: base >=4.12 && <5, containers >= 0.1 && <1, linear >= 1.0.1 && <2, freetype2 >= 0.2 && < 0.3, hashable >= 1.3 && <2, css-syntax, text, stylist-traits >= 0.1.1 && < 1, scientific @@ -93,7 +93,7 @@ -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.12 && <4.13, fontconfig-pure + build-depends: base >=4.12 && <5, fontconfig-pure -- Directories containing source files. -- hs-source-dirs: @@ -106,4 +106,4 @@ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Test.hs - build-depends: base >= 4.12 && <4.13, fontconfig-pure, hspec, QuickCheck + build-depends: base >= 4.12 && <5, fontconfig-pure, hspec, QuickCheck