{-# LINE 1 "Data/JsonStream/CLexType.hsc" #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.JsonStream.CLexType where import Foreign.C.Types import Foreign newtype LexResultType = LexResultType CInt deriving (Int -> LexResultType -> ShowS [LexResultType] -> ShowS LexResultType -> String (Int -> LexResultType -> ShowS) -> (LexResultType -> String) -> ([LexResultType] -> ShowS) -> Show LexResultType forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> LexResultType -> ShowS showsPrec :: Int -> LexResultType -> ShowS $cshow :: LexResultType -> String show :: LexResultType -> String $cshowList :: [LexResultType] -> ShowS showList :: [LexResultType] -> ShowS Show, LexResultType -> LexResultType -> Bool (LexResultType -> LexResultType -> Bool) -> (LexResultType -> LexResultType -> Bool) -> Eq LexResultType forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: LexResultType -> LexResultType -> Bool == :: LexResultType -> LexResultType -> Bool $c/= :: LexResultType -> LexResultType -> Bool /= :: LexResultType -> LexResultType -> Bool Eq, Ptr LexResultType -> IO LexResultType Ptr LexResultType -> Int -> IO LexResultType Ptr LexResultType -> Int -> LexResultType -> IO () Ptr LexResultType -> LexResultType -> IO () LexResultType -> Int (LexResultType -> Int) -> (LexResultType -> Int) -> (Ptr LexResultType -> Int -> IO LexResultType) -> (Ptr LexResultType -> Int -> LexResultType -> IO ()) -> (forall b. Ptr b -> Int -> IO LexResultType) -> (forall b. Ptr b -> Int -> LexResultType -> IO ()) -> (Ptr LexResultType -> IO LexResultType) -> (Ptr LexResultType -> LexResultType -> IO ()) -> Storable LexResultType forall b. Ptr b -> Int -> IO LexResultType forall b. Ptr b -> Int -> LexResultType -> IO () forall a. (a -> Int) -> (a -> Int) -> (Ptr a -> Int -> IO a) -> (Ptr a -> Int -> a -> IO ()) -> (forall b. Ptr b -> Int -> IO a) -> (forall b. Ptr b -> Int -> a -> IO ()) -> (Ptr a -> IO a) -> (Ptr a -> a -> IO ()) -> Storable a $csizeOf :: LexResultType -> Int sizeOf :: LexResultType -> Int $calignment :: LexResultType -> Int alignment :: LexResultType -> Int $cpeekElemOff :: Ptr LexResultType -> Int -> IO LexResultType peekElemOff :: Ptr LexResultType -> Int -> IO LexResultType $cpokeElemOff :: Ptr LexResultType -> Int -> LexResultType -> IO () pokeElemOff :: Ptr LexResultType -> Int -> LexResultType -> IO () $cpeekByteOff :: forall b. Ptr b -> Int -> IO LexResultType peekByteOff :: forall b. Ptr b -> Int -> IO LexResultType $cpokeByteOff :: forall b. Ptr b -> Int -> LexResultType -> IO () pokeByteOff :: forall b. Ptr b -> Int -> LexResultType -> IO () $cpeek :: Ptr LexResultType -> IO LexResultType peek :: Ptr LexResultType -> IO LexResultType $cpoke :: Ptr LexResultType -> LexResultType -> IO () poke :: Ptr LexResultType -> LexResultType -> IO () Storable) resNumber :: LexResultType resNumber :: LexResultType resNumber = CInt -> LexResultType LexResultType CInt 0 resString :: LexResultType resString :: LexResultType resString = CInt -> LexResultType LexResultType CInt 1 resTrue :: LexResultType resTrue :: LexResultType resTrue = CInt -> LexResultType LexResultType CInt 2 resFalse :: LexResultType resFalse :: LexResultType resFalse = CInt -> LexResultType LexResultType CInt 3 resNull :: LexResultType resNull :: LexResultType resNull = CInt -> LexResultType LexResultType CInt 4 resOpenBrace :: LexResultType resOpenBrace :: LexResultType resOpenBrace = CInt -> LexResultType LexResultType CInt 5 resCloseBrace :: LexResultType resCloseBrace :: LexResultType resCloseBrace = CInt -> LexResultType LexResultType CInt 6 resOpenBracket :: LexResultType resOpenBracket :: LexResultType resOpenBracket = CInt -> LexResultType LexResultType CInt 7 resCloseBracket :: LexResultType resCloseBracket :: LexResultType resCloseBracket = CInt -> LexResultType LexResultType CInt 8 resStringPartial :: LexResultType resStringPartial :: LexResultType resStringPartial = CInt -> LexResultType LexResultType CInt 9 resNumberPartial :: LexResultType resNumberPartial :: LexResultType resNumberPartial = CInt -> LexResultType LexResultType CInt 10 resNumberSmall :: LexResultType resNumberSmall :: LexResultType resNumberSmall = CInt -> LexResultType LexResultType CInt 12 {-# LINE 27 "Data/JsonStream/CLexType.hsc" #-}