{-# 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" #-}