~alcinnz/fontconfig-pure

ref: 5aedd01fd07e5401143c090b8a53ab69fd4ea816 fontconfig-pure/Graphics/Text/Font/Choose/Result.hs -rw-r--r-- 1.3 KiB
5aedd01f — Adrian Cochrane Add error detection to FcRange bindings. 2 years ago
                                                                                
160a3581 Adrian Cochrane
e21707cb Adrian Cochrane
24a77a5f Adrian Cochrane
64bcb432 Adrian Cochrane
e21707cb Adrian Cochrane
64bcb432 Adrian Cochrane
24a77a5f Adrian Cochrane
64bcb432 Adrian Cochrane
24a77a5f Adrian Cochrane
64bcb432 Adrian Cochrane
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
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
    deriving (Eq, Show, Read, Enum)

resultFromPointer :: Ptr Int -> IO Result
resultFromPointer res = toEnum <$> peek res

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 = throwResult . toEnum
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