{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}

module PgQuery.Internal.Parse where

import Control.Applicative (pure)
import Control.Monad.Fail (fail)
import Data.Bool (Bool (False, True))
import Data.ByteString (ByteString, packCStringLen)
import Data.Either (Either (Left, Right))
import Data.Eq (Eq, (==))
import Data.Function (($))
import Data.String (String)
import Foreign
  ( Ptr,
    Storable
      ( alignment,
        peek,
        peekByteOff,
        poke,
        sizeOf
      ),
    nullPtr,
  )
import Foreign.C
  ( CInt,
    CSize,
    CString,
    peekCString,
    withCString,
  )
import Foreign.C.Types (CSize (..))
import GHC.Err (undefined)
import GHC.IO (IO)
import GHC.Num ((*), (+))
import GHC.Real (fromIntegral)
import GHC.Show (Show)

-- | Data type corresponding to the following struct in 'pg_query.h':
--
--   @
--     typedef struct {
--       size_t len;
--       char* data;
--     } PgQueryProtobuf;
--   @
data PgQueryProtobuf = PgQueryProtobuf
  { PgQueryProtobuf -> CSize
len :: !CSize
  , PgQueryProtobuf -> CString
protobufData :: !CString
  }
  deriving (Int -> PgQueryProtobuf -> ShowS
[PgQueryProtobuf] -> ShowS
PgQueryProtobuf -> String
(Int -> PgQueryProtobuf -> ShowS)
-> (PgQueryProtobuf -> String)
-> ([PgQueryProtobuf] -> ShowS)
-> Show PgQueryProtobuf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PgQueryProtobuf -> ShowS
showsPrec :: Int -> PgQueryProtobuf -> ShowS
$cshow :: PgQueryProtobuf -> String
show :: PgQueryProtobuf -> String
$cshowList :: [PgQueryProtobuf] -> ShowS
showList :: [PgQueryProtobuf] -> ShowS
Show, PgQueryProtobuf -> PgQueryProtobuf -> Bool
(PgQueryProtobuf -> PgQueryProtobuf -> Bool)
-> (PgQueryProtobuf -> PgQueryProtobuf -> Bool)
-> Eq PgQueryProtobuf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PgQueryProtobuf -> PgQueryProtobuf -> Bool
== :: PgQueryProtobuf -> PgQueryProtobuf -> Bool
$c/= :: PgQueryProtobuf -> PgQueryProtobuf -> Bool
/= :: PgQueryProtobuf -> PgQueryProtobuf -> Bool
Eq)

instance Storable PgQueryProtobuf where
  sizeOf :: PgQueryProtobuf -> Int
sizeOf PgQueryProtobuf
_ =
    CSize -> Int
forall a. Storable a => a -> Int
sizeOf (CSize
forall a. HasCallStack => a
undefined :: CSize)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)

  alignment :: PgQueryProtobuf -> Int
alignment PgQueryProtobuf
_ = PgQueryProtobuf -> Int
forall a. Storable a => a -> Int
alignment (PgQueryProtobuf
forall a. HasCallStack => a
undefined :: PgQueryProtobuf)

  peek :: Ptr PgQueryProtobuf -> IO PgQueryProtobuf
peek Ptr PgQueryProtobuf
ptr = do
    CSize
len <- Ptr PgQueryProtobuf -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryProtobuf
ptr Int
0
    CString
protobufData <- Ptr PgQueryProtobuf -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryProtobuf
ptr (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CSize -> Int
forall a. Storable a => a -> Int
sizeOf (CSize
forall a. HasCallStack => a
undefined :: CSize))
    PgQueryProtobuf -> IO PgQueryProtobuf
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PgQueryProtobuf
        { CSize
len :: CSize
len :: CSize
len
        , CString
protobufData :: CString
protobufData :: CString
protobufData
        }

  poke :: Ptr PgQueryProtobuf -> PgQueryProtobuf -> IO ()
poke Ptr PgQueryProtobuf
_ PgQueryProtobuf
_ = String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PgQueryProtobuf poke: not supported"

-- | Data type corresponding to the following struct in 'pg_query.h':
--
--   @
--     typedef struct {
--     	char* message; // exception message
--     	char* funcname; // source function of exception (e.g. SearchSysCache)
--     	char* filename; // source of exception (e.g. parse.l)
--     	int lineno; // source of exception (e.g. 104)
--     	int cursorpos; // char in query at which exception occurred
--     	char* context; // additional context (optional, can be NULL)
--     } PgQueryError;
--   @
data PgQueryError = PgQueryError
  { PgQueryError -> CString
message :: !CString
  , PgQueryError -> CString
funcname :: !CString
  , PgQueryError -> CString
filename :: !CString
  , PgQueryError -> CInt
lineno :: !CInt
  , PgQueryError -> CInt
cursorpos :: !CInt
  , PgQueryError -> CString
context :: !CString
  }
  deriving (Int -> PgQueryError -> ShowS
[PgQueryError] -> ShowS
PgQueryError -> String
(Int -> PgQueryError -> ShowS)
-> (PgQueryError -> String)
-> ([PgQueryError] -> ShowS)
-> Show PgQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PgQueryError -> ShowS
showsPrec :: Int -> PgQueryError -> ShowS
$cshow :: PgQueryError -> String
show :: PgQueryError -> String
$cshowList :: [PgQueryError] -> ShowS
showList :: [PgQueryError] -> ShowS
Show, PgQueryError -> PgQueryError -> Bool
(PgQueryError -> PgQueryError -> Bool)
-> (PgQueryError -> PgQueryError -> Bool) -> Eq PgQueryError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PgQueryError -> PgQueryError -> Bool
== :: PgQueryError -> PgQueryError -> Bool
$c/= :: PgQueryError -> PgQueryError -> Bool
/= :: PgQueryError -> PgQueryError -> Bool
Eq)

instance Storable PgQueryError where
  sizeOf :: PgQueryError -> Int
sizeOf PgQueryError
_ =
    CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)

  alignment :: PgQueryError -> Int
alignment PgQueryError
_ = PgQueryError -> Int
forall a. Storable a => a -> Int
alignment (PgQueryError
forall a. HasCallStack => a
undefined :: PgQueryError)

  peek :: Ptr PgQueryError -> IO PgQueryError
peek Ptr PgQueryError
ptr = do
    CString
message <- Ptr PgQueryError -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryError
ptr Int
0
    CString
funcname <- Ptr PgQueryError -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryError
ptr (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString))
    CString
filename <- Ptr PgQueryError -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryError
ptr (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString))
    CInt
lineno <- Ptr PgQueryError -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryError
ptr (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString))
    CInt
cursorpos <- Ptr PgQueryError -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryError
ptr ((Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt))
    CString
context <- Ptr PgQueryError -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryError
ptr ((Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf (CInt
forall a. HasCallStack => a
undefined :: CInt)))
    PgQueryError -> IO PgQueryError
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PgQueryError
        { CString
message :: CString
message :: CString
message
        , CString
funcname :: CString
funcname :: CString
funcname
        , CString
filename :: CString
filename :: CString
filename
        , CInt
lineno :: CInt
lineno :: CInt
lineno
        , CInt
cursorpos :: CInt
cursorpos :: CInt
cursorpos
        , CString
context :: CString
context :: CString
context
        }

  poke :: Ptr PgQueryError -> PgQueryError -> IO ()
poke Ptr PgQueryError
_ PgQueryError
_ = String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PgQueryError poke: not supported"

-- | Data type corresponding to the following struct in 'pg_query.h':
--
--   @
--     typedef struct {
--       PgQueryProtobuf parse_tree;
--       char* stderr_buffer;
--       PgQueryError* error;
--     } PgQueryProtobufParseResult;
--   @
data PgQueryProtobufParseResult = PgQueryProtobufParseResult
  { PgQueryProtobufParseResult -> PgQueryProtobuf
parse_tree :: !PgQueryProtobuf
  , PgQueryProtobufParseResult -> CString
stderr_buffer :: !CString
  , PgQueryProtobufParseResult -> Ptr PgQueryError
pg_query_error :: !(Ptr PgQueryError)
  }
  deriving (Int -> PgQueryProtobufParseResult -> ShowS
[PgQueryProtobufParseResult] -> ShowS
PgQueryProtobufParseResult -> String
(Int -> PgQueryProtobufParseResult -> ShowS)
-> (PgQueryProtobufParseResult -> String)
-> ([PgQueryProtobufParseResult] -> ShowS)
-> Show PgQueryProtobufParseResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PgQueryProtobufParseResult -> ShowS
showsPrec :: Int -> PgQueryProtobufParseResult -> ShowS
$cshow :: PgQueryProtobufParseResult -> String
show :: PgQueryProtobufParseResult -> String
$cshowList :: [PgQueryProtobufParseResult] -> ShowS
showList :: [PgQueryProtobufParseResult] -> ShowS
Show)

instance Storable PgQueryProtobufParseResult where
  sizeOf :: PgQueryProtobufParseResult -> Int
sizeOf PgQueryProtobufParseResult
_ =
    PgQueryProtobuf -> Int
forall a. Storable a => a -> Int
sizeOf (PgQueryProtobuf
forall a. HasCallStack => a
undefined :: PgQueryProtobuf)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString)
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Ptr PgQueryError -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr PgQueryError
forall a. HasCallStack => a
undefined :: Ptr PgQueryError)

  alignment :: PgQueryProtobufParseResult -> Int
alignment PgQueryProtobufParseResult
_ = PgQueryProtobufParseResult -> Int
forall a. Storable a => a -> Int
alignment (PgQueryProtobufParseResult
forall a. HasCallStack => a
undefined :: PgQueryProtobufParseResult)

  peek :: Ptr PgQueryProtobufParseResult -> IO PgQueryProtobufParseResult
peek Ptr PgQueryProtobufParseResult
ptr = do
    PgQueryProtobuf
parse_tree <- Ptr PgQueryProtobufParseResult -> Int -> IO PgQueryProtobuf
forall b. Ptr b -> Int -> IO PgQueryProtobuf
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryProtobufParseResult
ptr Int
0
    CString
stderr_buffer <- Ptr PgQueryProtobufParseResult -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryProtobufParseResult
ptr (PgQueryProtobuf -> Int
forall a. Storable a => a -> Int
sizeOf (PgQueryProtobuf
forall a. HasCallStack => a
undefined :: PgQueryProtobuf))
    Ptr PgQueryError
pg_query_error <- Ptr PgQueryProtobufParseResult -> Int -> IO (Ptr PgQueryError)
forall b. Ptr b -> Int -> IO (Ptr PgQueryError)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr PgQueryProtobufParseResult
ptr (PgQueryProtobuf -> Int
forall a. Storable a => a -> Int
sizeOf (PgQueryProtobuf
forall a. HasCallStack => a
undefined :: PgQueryProtobuf) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ CString -> Int
forall a. Storable a => a -> Int
sizeOf (CString
forall a. HasCallStack => a
undefined :: CString))
    PgQueryProtobufParseResult -> IO PgQueryProtobufParseResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PgQueryProtobufParseResult
        { PgQueryProtobuf
parse_tree :: PgQueryProtobuf
parse_tree :: PgQueryProtobuf
parse_tree
        , CString
stderr_buffer :: CString
stderr_buffer :: CString
stderr_buffer
        , Ptr PgQueryError
pg_query_error :: Ptr PgQueryError
pg_query_error :: Ptr PgQueryError
pg_query_error
        }

  poke :: Ptr PgQueryProtobufParseResult
-> PgQueryProtobufParseResult -> IO ()
poke Ptr PgQueryProtobufParseResult
_ PgQueryProtobufParseResult
_ = String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PgQueryProtobufParseResult poke: not supported"

foreign import ccall "get_sql"
  get_sql ::
    CString ->
    IO (Ptr PgQueryProtobufParseResult)

foreign import ccall "free_sql"
  free_sql ::
    Ptr PgQueryProtobufParseResult ->
    IO ()

getProtobufParseResult :: String -> IO (Either String ByteString)
getProtobufParseResult :: String -> IO (Either String ByteString)
getProtobufParseResult String
sql = do
  Ptr PgQueryProtobufParseResult
resultPtr <- String
-> (CString -> IO (Ptr PgQueryProtobufParseResult))
-> IO (Ptr PgQueryProtobufParseResult)
forall a. String -> (CString -> IO a) -> IO a
withCString String
sql CString -> IO (Ptr PgQueryProtobufParseResult)
get_sql
  PgQueryProtobufParseResult
result <- Ptr PgQueryProtobufParseResult -> IO PgQueryProtobufParseResult
forall a. Storable a => Ptr a -> IO a
peek Ptr PgQueryProtobufParseResult
resultPtr

  let errPtr :: Ptr PgQueryError
errPtr = PgQueryProtobufParseResult -> Ptr PgQueryError
pg_query_error PgQueryProtobufParseResult
result
  case Ptr PgQueryError
errPtr Ptr PgQueryError -> Ptr PgQueryError -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr PgQueryError
forall a. Ptr a
nullPtr of
    Bool
True -> do
      let tree :: PgQueryProtobuf
tree = PgQueryProtobufParseResult -> PgQueryProtobuf
parse_tree PgQueryProtobufParseResult
result
      ByteString
protobufResult <- CStringLen -> IO ByteString
packCStringLen (PgQueryProtobuf -> CString
protobufData PgQueryProtobuf
tree, CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ PgQueryProtobuf -> CSize
len PgQueryProtobuf
tree)

      Ptr PgQueryProtobufParseResult -> IO ()
free_sql Ptr PgQueryProtobufParseResult
resultPtr

      Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> IO (Either String ByteString))
-> Either String ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
protobufResult
    Bool
False -> do
      PgQueryError
errorResult <- Ptr PgQueryError -> IO PgQueryError
forall a. Storable a => Ptr a -> IO a
peek Ptr PgQueryError
errPtr
      String
errorMessage <- CString -> IO String
peekCString (PgQueryError -> CString
message PgQueryError
errorResult)

      Ptr PgQueryProtobufParseResult -> IO ()
free_sql Ptr PgQueryProtobufParseResult
resultPtr

      Either String ByteString -> IO (Either String ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ByteString -> IO (Either String ByteString))
-> Either String ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ String -> Either String ByteString
forall a b. a -> Either a b
Left String
errorMessage