~alcinnz/fontconfig-pure

ref: b4f50b899d7bdc31953ee467b88ba795596635d1 fontconfig-pure/Graphics/Text/Font/Choose/Result.hs -rw-r--r-- 1.3 KiB
b4f50b89 — Adrian Cochrane Correct FcConfig memory handling & exception throwing. 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