module Database.Pathfinder
(
compileFerry
, compileFerryOpt
, OutputFormat (..)
, XmlString
, ErrorString
, OutputString
, OptArgs
) where
import Foreign
import Foreign.C
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString as B
newtype COutputFormat = COutputFormat { unCOutputFormat :: CInt }
c_PFoutput_format_sql :: COutputFormat
c_PFoutput_format_sql = COutputFormat 0
c_PFoutput_format_xml :: COutputFormat
c_PFoutput_format_xml = COutputFormat 1
c_PFoutput_format_dot :: COutputFormat
c_PFoutput_format_dot = COutputFormat 2
data OutputFormat
= OutputSql
| OutputXml
| OutputDot
outputFormatToCInt :: OutputFormat -> CInt
outputFormatToCInt output = unCOutputFormat $
case output of
OutputSql -> c_PFoutput_format_sql
OutputXml -> c_PFoutput_format_xml
OutputDot -> c_PFoutput_format_dot
type XmlString = String
type ErrorString = String
type OutputString = String
type OptArgs = String
foreign import ccall safe "PFcompile_ferry"
c'PFcompile_ferry :: Ptr CString -> CString -> CString -> CInt -> IO CInt
compileFerry :: XmlString
-> OutputFormat
-> IO (Either ErrorString OutputString)
compileFerry xml output = do
B.useAsCString (T.encodeUtf8 (T.pack xml)) $ \c'xml ->
alloca $ \ptr -> alloca $ \c'err -> do
ci <- c'PFcompile_ferry ptr c'err c'xml (outputFormatToCInt output)
if ci == 0
then Right `fmap` (peek ptr >>= B.packCString >>= (return . T.unpack . T.decodeUtf8))
else Left `fmap` (B.packCString c'err >>= (return . T.unpack . T.decodeUtf8))
foreign import ccall safe "PFcompile_ferry_opt"
c'PFcompile_ferry_opt :: Ptr CString -> CString -> CString -> CInt -> CString -> IO CInt
compileFerryOpt :: XmlString
-> OutputFormat
-> Maybe OptArgs
-> IO (Either ErrorString OutputString)
compileFerryOpt xml output optimization = do
B.useAsCString (T.encodeUtf8 (T.pack xml)) $ \c'xml ->
alloca $ \ptr -> alloca $ \c'err -> do
opt <- maybe (return nullPtr)
newCString
optimization
ci <- c'PFcompile_ferry_opt ptr c'err c'xml (outputFormatToCInt output) opt
if ci == 0
then Right `fmap` (peek ptr >>= B.packCString >>= (return . T.unpack . T.decodeUtf8))
else Left `fmap` (B.packCString c'err >>= (return . T.unpack . T.decodeUtf8))