module Database.Pathfinder
(
pathfinder
, OutputFormat (..)
, XmlString
, ErrorString
, OutputString
, OptString
) where
import Foreign
import Foreign.C
import Control.Concurrent.MVar (MVar,takeMVar,putMVar,newEmptyMVar)
import qualified System.IO.Unsafe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString as B
globalMVar :: MVar ()
globalMVar = System.IO.Unsafe.unsafePerformIO (newEmptyMVar)
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 OptString = String
foreign import ccall safe "PFcompile_ferry_opt"
c_PFcompile_ferry_opt :: Ptr CString -> CString -> CString -> CInt -> CString -> IO CInt
pathfinder :: XmlString
-> OptString
-> OutputFormat
-> IO (Either ErrorString OutputString)
pathfinder xml optimisation output = do
putMVar globalMVar ()
let bs = T.encodeUtf8 (T.pack xml)
r <- B.useAsCString bs $ \c_xml ->
alloca $ \c_ptr ->
alloca $ \c_err -> do
c_opt <- case optimisation of
[] -> return nullPtr
_ -> newCString optimisation
ci <- c_PFcompile_ferry_opt c_ptr c_err c_xml (outputFormatToCInt output) c_opt
free c_opt
if ci == 0
then do
c_string <- peek c_ptr
r <- fmap (T.unpack . T.decodeUtf8) (B.packCString c_string)
free c_string
return (Right r)
else fmap (Left . T.unpack . T.decodeUtf8) (B.packCString c_err)
takeMVar globalMVar
return r