module Graphics.Text.Font.Choose.Result (Result(..), Word8, resultFromPointer,
    Error(..), throwResult, throwInt, throwPtr, throwFalse, throwNull) where

import Foreign.Storable (peek)
import Foreign.Ptr (Ptr, nullPtr)
import Control.Exception (throwIO, throw, Exception)
import Data.Word (Word8)

data Result = Match | NoMatch | TypeMismatch | ResultNoId | OutOfMemory | Other
    deriving (Result -> Result -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show, ReadPrec [Result]
ReadPrec Result
Int -> ReadS Result
ReadS [Result]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Result]
$creadListPrec :: ReadPrec [Result]
readPrec :: ReadPrec Result
$creadPrec :: ReadPrec Result
readList :: ReadS [Result]
$creadList :: ReadS [Result]
readsPrec :: Int -> ReadS Result
$creadsPrec :: Int -> ReadS Result
Read, Int -> Result
Result -> Int
Result -> [Result]
Result -> Result
Result -> Result -> [Result]
Result -> Result -> Result -> [Result]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Result -> Result -> Result -> [Result]
$cenumFromThenTo :: Result -> Result -> Result -> [Result]
enumFromTo :: Result -> Result -> [Result]
$cenumFromTo :: Result -> Result -> [Result]
enumFromThen :: Result -> Result -> [Result]
$cenumFromThen :: Result -> Result -> [Result]
enumFrom :: Result -> [Result]
$cenumFrom :: Result -> [Result]
fromEnum :: Result -> Int
$cfromEnum :: Result -> Int
toEnum :: Int -> Result
$ctoEnum :: Int -> Result
pred :: Result -> Result
$cpred :: Result -> Result
succ :: Result -> Result
$csucc :: Result -> Result
Enum, Result
forall a. a -> a -> Bounded a
maxBound :: Result
$cmaxBound :: Result
minBound :: Result
$cminBound :: Result
Bounded)

resultFromPointer :: Ptr Word8 -> IO Result
resultFromPointer :: Ptr Word8 -> IO Result
resultFromPointer Ptr Word8
res = forall a. Enum a => Word8 -> a
toEnum8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
res

toEnum8 :: Enum a => Word8 -> a
toEnum8 :: forall a. Enum a => Word8 -> a
toEnum8 = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

data Error = ErrTypeMismatch | ErrResultNoId | ErrOutOfMemory deriving (Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, ReadPrec [Error]
ReadPrec Error
Int -> ReadS Error
ReadS [Error]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Error]
$creadListPrec :: ReadPrec [Error]
readPrec :: ReadPrec Error
$creadPrec :: ReadPrec Error
readList :: ReadS [Error]
$creadList :: ReadS [Error]
readsPrec :: Int -> ReadS Error
$creadsPrec :: Int -> ReadS Error
Read)
instance Exception Error

throwResult :: Result -> IO a -> IO (Maybe a)
throwResult :: forall a. Result -> IO a -> IO (Maybe a)
throwResult Result
Match IO a
x = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
x
throwResult Result
NoMatch IO a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
throwResult Result
TypeMismatch IO a
_ = forall e a. Exception e => e -> IO a
throwIO Error
ErrTypeMismatch
throwResult Result
ResultNoId IO a
_ = forall e a. Exception e => e -> IO a
throwIO Error
ErrResultNoId
throwResult Result
OutOfMemory IO a
_ = forall e a. Exception e => e -> IO a
throwIO Error
ErrOutOfMemory

throwInt :: Int -> IO a -> IO (Maybe a)
throwInt :: forall a. Int -> IO a -> IO (Maybe a)
throwInt Int
x
    | Int
x forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x forall a. Ord a => a -> a -> Bool
<= Int
4 = forall a. Result -> IO a -> IO (Maybe a)
throwResult forall a b. (a -> b) -> a -> b
$ forall a. Enum a => Int -> a
toEnum Int
x
    | Bool
otherwise = forall a. Result -> IO a -> IO (Maybe a)
throwResult forall a b. (a -> b) -> a -> b
$ Result
Other
throwPtr :: Ptr Word8 -> IO a -> IO (Maybe a)
throwPtr :: forall a. Ptr Word8 -> IO a -> IO (Maybe a)
throwPtr Ptr Word8
a IO a
b = Ptr Word8 -> IO Result
resultFromPointer Ptr Word8
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Result -> IO a -> IO (Maybe a)
throwResult IO a
b

throwFalse :: Bool -> IO ()
throwFalse :: Bool -> IO ()
throwFalse Bool
True = forall (m :: * -> *) a. Monad m => a -> m a
return ()
throwFalse Bool
False = forall e a. Exception e => e -> IO a
throwIO Error
ErrOutOfMemory
throwFalse' :: IO Bool -> IO ()
throwFalse' :: IO Bool -> IO ()
throwFalse' = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> IO ()
throwFalse)

throwNull :: Ptr a -> Ptr a
throwNull :: forall a. Ptr a -> Ptr a
throwNull Ptr a
ptr | Ptr a
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall a e. Exception e => e -> a
throw Error
ErrOutOfMemory
    | Bool
otherwise = Ptr a
ptr