~alcinnz/fontconfig-pure

ref: 9942f874b2b421d7602c9501a628fec66bf78757 fontconfig-pure/Graphics/Text/Font/Choose/Result.hs -rw-r--r-- 1.3 KiB
9942f874 — Adrian Cochrane Throw OOM errors for objectsets. 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