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
38
39
40
41
42
43
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 | Other
deriving (Eq, Show, Read, Enum, Bounded)
resultFromPointer :: Ptr Int -> IO Result
resultFromPointer res = do
ret <- peek res
if ret > fromEnum (maxBound :: Result) || ret < fromEnum (minBound :: Result)
then return Match -- FIXME: Why these erroneous exceptions thrown?
else return $ toEnum ret
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 x
| x >= 0 && x <= 4 = throwResult $ toEnum x
| otherwise = throwResult $ Other
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