~alcinnz/fontconfig-pure

ref: 8ddba96628a5f1d32d99d6b1b5f89e9e87e5df14 fontconfig-pure/Graphics/Text/Font/Choose/Result.hs -rw-r--r-- 1.5 KiB
8ddba966 — Adrian Cochrane Silence erroneous exceptions. 1 year, 9 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
module Graphics.Text.Font.Choose.Result (Result(..), resultFromPointer,
    Error(..), throwResult, throwInt, throwPtr, throwFalse, throwNull) where

import Foreign.Storable (peek)
import Foreign.Ptr (Ptr, nullPtr)
import Control.Exception (throwIO, throw, Exception)

data Result = Match | NoMatch | TypeMismatch | ResultNoId | OutOfMemory | Other
    deriving (Eq, Show, Read, Enum, Bounded)

resultFromPointer :: Ptr Int -> IO Result
resultFromPointer res = do
    ret <- peek res
    if ret > fromEnum (maxBound :: Result) || ret < fromEnum (minBound :: Result)
    then return Match -- Probably an erroneous value. FIXME Understand why this happens.
    else return $ toEnum ret

data Error = ErrTypeMismatch | ErrResultNoId | ErrOutOfMemory deriving (Eq, Show, Read)
instance Exception Error

throwResult :: Result -> IO a -> IO (Maybe a)
throwResult Match x = Just <$> x
throwResult NoMatch _ = return Nothing
throwResult TypeMismatch _ = throwIO ErrTypeMismatch
throwResult ResultNoId _ = throwIO ErrResultNoId
throwResult OutOfMemory _ = throwIO ErrOutOfMemory

throwInt :: Int -> IO a -> IO (Maybe a)
throwInt x
    | x >= 0 && x <= 4 = throwResult $ toEnum x
    | otherwise = throwResult $ Other
throwPtr :: Ptr Int -> IO a -> IO (Maybe a)
throwPtr a b = resultFromPointer a >>= flip throwResult b

throwFalse :: Bool -> IO ()
throwFalse True = return ()
throwFalse False = throwIO ErrOutOfMemory
throwFalse' :: IO Bool -> IO ()
throwFalse' = (>>= throwFalse)

throwNull :: Ptr a -> Ptr a
throwNull ptr | ptr == nullPtr = throw ErrOutOfMemory
    | otherwise = ptr