{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fwarn-unused-binds -fwarn-unused-imports #-}

module PgQuery
  ( module PgQuery.Internal.Proto.PgQuery,
    module PgQuery.Internal.Proto.PgQuery_Fields,
    parseSql,
  )
where

import Control.Applicative (pure)
import Data.Either (Either (Left, Right))
import Data.Function (($))
import Data.ProtoLens (decodeMessage)
import Data.String qualified as Base (String)
import GHC.IO (IO)
import PgQuery.Internal.Parse
  ( getProtobufParseResult,
  )
import PgQuery.Internal.Proto.PgQuery
import PgQuery.Internal.Proto.PgQuery_Fields

-- | Parses SQL, returning the internal PostgreSQL parse tree as a
--   'ParseResult'.
--
--   Here's an example:
--
--   @
--     main :: IO ()
--     main = do
--       eResult <- parseSql "select u.name, u.address from users u where u.id = $1"
--       case eResult of
--         Left err -> error err
--         Right result -> print result
--   @
--
--   To make meaningful use of the 'ParseResult', you'll want to use
--   "Control.Lens" in conjunction with the functions provided in
--   "PgQuery.Internal.Proto.PgQuery_Fields". See
--   [here](https://hackage.haskell.org/package/lens-tutorial-1.0.5/docs/Control-Lens-Tutorial.html)
--   for a tutorial on how to use lenses.
--
--   The tests for this library also contain some examples which may serve as a
--   helpful reference.
parseSql :: Base.String -> IO (Either Base.String ParseResult)
parseSql :: String -> IO (Either String ParseResult)
parseSql String
sql = do
  Either String ByteString
eTree <- String -> IO (Either String ByteString)
getProtobufParseResult String
sql
  case Either String ByteString
eTree of
    Left String
err -> Either String ParseResult -> IO (Either String ParseResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ParseResult -> IO (Either String ParseResult))
-> Either String ParseResult -> IO (Either String ParseResult)
forall a b. (a -> b) -> a -> b
$ String -> Either String ParseResult
forall a b. a -> Either a b
Left String
err
    Right ByteString
result -> Either String ParseResult -> IO (Either String ParseResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ParseResult -> IO (Either String ParseResult))
-> Either String ParseResult -> IO (Either String ParseResult)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ParseResult
forall msg. Message msg => ByteString -> Either String msg
decodeMessage ByteString
result