~alcinnz/fontconfig-pure

ref: 9e1e5029f66325c1391a658c39c4573e74aafe03 fontconfig-pure/Graphics/Text/Font/Choose/Result.hs -rw-r--r-- 1.3 KiB
9e1e5029 — Adrian Cochrane Commit FontSet API (seperated out to break import loop). 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