~alcinnz/fontconfig-pure

ref: 6982c3dd25fc94e0cf45e71a55e44e4db53bf452 fontconfig-pure/Graphics/Text/Font/Choose/Result.hs -rw-r--r-- 1.3 KiB
6982c3dd — Adrian Cochrane Commit moved FreeType integration module. 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