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
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
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
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
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]
(Int -> ReadS Result)
-> ReadS [Result]
-> ReadPrec Result
-> ReadPrec [Result]
-> Read 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]
(Result -> Result)
-> (Result -> Result)
-> (Int -> Result)
-> (Result -> Int)
-> (Result -> [Result])
-> (Result -> Result -> [Result])
-> (Result -> Result -> [Result])
-> (Result -> Result -> Result -> [Result])
-> Enum 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
Result -> Result -> Bounded 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 res :: Ptr Word8
res = Word8 -> Result
forall a. Enum a => Word8 -> a
toEnum8 (Word8 -> Result) -> IO Word8 -> IO Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
res

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

data Error = ErrTypeMismatch | ErrResultNoId | ErrOutOfMemory deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
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
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
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]
(Int -> ReadS Error)
-> ReadS [Error]
-> ReadPrec Error
-> ReadPrec [Error]
-> Read 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 :: Result -> IO a -> IO (Maybe a)
throwResult Match x :: IO a
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
x
throwResult NoMatch _ = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
throwResult TypeMismatch _ = Error -> IO (Maybe a)
forall e a. Exception e => e -> IO a
throwIO Error
ErrTypeMismatch
throwResult ResultNoId _ = Error -> IO (Maybe a)
forall e a. Exception e => e -> IO a
throwIO Error
ErrResultNoId
throwResult OutOfMemory _ = Error -> IO (Maybe a)
forall e a. Exception e => e -> IO a
throwIO Error
ErrOutOfMemory

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

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

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